Changeset 1586

Timestamp:

Oct 30, 2012, 1:11:02 PM (12 years ago)

Author:

Sam Habiel

Message:

Changed license to AGPL. Some clean-up for XINDEX

Location:

ccr/trunk/p

Files:

• C0CACTOR.m (modified) (1 diff)
• C0CALERT.m (modified) (2 diffs)
• C0CBAT.m (modified) (4 diffs)
• C0CCCD.m (modified) (1 diff)
• C0CCCD1.m (modified) (1 diff)
• C0CCCR.m (modified) (2 diffs)
• C0CCCR0.m (modified) (1 diff)
• C0CCMT.m (modified) (1 diff)
• C0CCPT.m (modified) (2 diffs)
• C0CDIC.m (modified) (1 diff)
• C0CDOM.m (modified) (8 diffs)
• C0CDPT.m (modified) (1 diff)
• C0CENC.m (modified) (2 diffs)
• C0CENV.m (modified) (1 diff)
• C0CEVC.m (modified) (1 diff)
• C0CEWD.m (modified) (1 diff)
• C0CEWD1.m (modified) (1 diff)
• C0CFM1.m (modified) (2 diffs)
• C0CFM2.m (modified) (6 diffs)
• C0CFM3.m (modified) (5 diffs)
• C0CIM2.m (modified) (1 diff)
• C0CIMMU.m (modified) (1 diff)
• C0CIN.m (modified) (2 diffs)
• C0CLA7DD.m (modified) (2 diffs)
• C0CLA7Q.m (modified) (1 diff)
• C0CLABS.m (modified) (3 diffs)
• C0CMAIL.m (modified) (1 diff)
• C0CMAIL2.m (modified) (1 diff)
• C0CMAIL3.m (modified) (1 diff)
• C0CMCCD.m (modified) (2 diffs)
• C0CMED.m (modified) (5 diffs)
• C0CMED1.m (modified) (2 diffs)
• C0CMED2.m (modified) (2 diffs)
• C0CMED3.m (modified) (2 diffs)
• C0CMED4.m (modified) (7 diffs)
• C0CMED6.m (modified) (6 diffs)
• C0CMIME.m (modified) (7 diffs)
• C0CMXML.m (modified) (5 diffs)
• C0CMXMLB.m (modified) (2 diffs)
• C0CMXP.m (modified) (3 diffs)
• C0CNHIN.m (modified) (9 diffs)
• C0CNMED2.m (modified) (1 diff)
• C0CNMED4.m (modified) (5 diffs)
• C0CORSLT.m (modified) (1 diff)
• C0COVREL.m (modified) (1 diff)
• C0COVRES.m (modified) (1 diff)
• C0COVREU.m (modified) (1 diff)
• C0CPARMS.m (modified) (1 diff)
• C0CPROBS.m (modified) (4 diffs)
• C0CPROC.m (modified) (2 diffs)
• C0CPXRM.m (modified) (1 diff)
• C0CQRY1.m (modified) (1 diff)
• C0CQRY2.m (modified) (1 diff)
• C0CRAHL7.m (modified) (1 diff)
• C0CRARPT.m (modified) (1 diff)
• C0CRIMA.m (modified) (4 diffs)
• C0CRNF.m (modified) (3 diffs)
• C0CRNFRP.m (modified) (1 diff)
• C0CRPMS.m (modified) (3 diffs)
• C0CRXN.m (modified) (7 diffs)
• C0CRXNRD.m (modified) (6 diffs)
• C0CSNOA.m (modified) (3 diffs)
• C0CSOAP.m (modified) (1 diff)
• C0CSQMB.m (modified) (1 diff)
• C0CSUB1.m (modified) (3 diffs)
• C0CSYS.m (modified) (1 diff)
• C0CTIU.m (modified) (1 diff)
• C0CTIU1.m (modified) (1 diff)
• C0CUNIT.m (modified) (2 diffs)
• C0CUTIL.m (modified) (4 diffs)
• C0CVA200.m (modified) (1 diff)
• C0CVALID.m (modified) (1 diff)
• C0CVIT2.m (modified) (18 diffs)
• C0CVITAL.m (modified) (5 diffs)
• C0CVOBX1.m (modified) (1 diff)
• C0CVORU.m (modified) (1 diff)
• C0CXEWD.m (modified) (1 diff)
• C0CXPAT0.m (modified) (1 diff)
• C0CXPATH.m (modified) (4 diffs)

ccr/trunk/p/C0CACTOR.m

@@ -1 @@
-C0CACTOR         ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+C0CACTOR         ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ; 10/29/12 4:04pm
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ;
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ;  PROCESS THE ACTORS SECTION OF THE CCR

ccr/trunk/p/C0CALERT.m

@@ -1 @@
-C0CALERT         ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+C0CALERT         ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 ; 10/29/12 4:04pm
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         W "NO ENTRY FROM TOP",!
@@ -30 +28 @@
         S GMRA="0^0^111"
         D EN1^GMRADPT
-        I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
+        I $G(GMRAL)'=1 D  Q  ; NO ALLERGIES FOUND THUS *QUIT*
         . S @ALTOUTXML@(0)=0
         ; DEFINE MAPPING

ccr/trunk/p/C0CBAT.m

@@ -1 +1 @@
 C0CBAT    ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         W "This is the CCR Batch Utility Library ",!
@@ -63 +62 @@
         I $D(@C0CBB@(0)) D  ; ERROR SHOULDN'T EXIST
         . W "WORK AREA ERROR",!
-        . B
+        . S $EC=",U1,"
         S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
         S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
@@ -164 +163 @@
         Q ZN
         ;
-UPDIEVARPTR(ZVAR,ZTYP)  ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+UVARPTR(ZVAR,ZTYP)      ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
         ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
         ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
@@ -190 +189 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q

ccr/trunk/p/C0CCCD.m

@@ -1 +1 @@
 C0CCCD    ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ; EXPORT A CCR
         ;
 EXPORT    ; EXPORT ENTRY POINT FOR CCR
-              ; Select a patient.
-              S DIC=2,DIC(0)="AEMQ" D ^DIC
-              I Y<1 Q  ; EXIT
-              S DFN=$P(Y,U,1) ; SET THE PATIENT
-              D XPAT(DFN,"","") ; EXPORT TO A FILE
-              Q
-              ;
+        ; Select a patient.
+        S DIC=2,DIC(0)="AEMQ" D ^DIC
+        I Y<1 Q  ; EXIT
+        S DFN=$P(Y,U,1) ; SET THE PATIENT
+        D XPAT(DFN,"","") ; EXPORT TO A FILE
+        Q
+        ;
 XPAT(DFN,DIR,FN)        ; EXPORT ONE PATIENT TO A FILE
-              ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
-              ; FN IS FILE NAME, DEFAULTS IF NULL
-              ; N CCDGLO
-              D CCDRPC(.CCDGLO,DFN,"CCD","","","")
-              S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
-              S ONAM=FN
-              I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
-              S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
-              I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-              . S @ODIRGLB="/home/glilly/CCROUT"
-              . ;S @ODIRGLB="/home/cedwards/"
-              . ;S @ODIRGLB="/opt/wv/p/"
-              S ODIR=DIR
-              I DIR="" S ODIR=@ODIRGLB
-              N ZY
-              S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
-              W $P(ZY,U,2)
-              Q
-              ;
+        ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
+        ; FN IS FILE NAME, DEFAULTS IF NULL
+        ; N CCDGLO
+        D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+        S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
+        S ONAM=FN
+        I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+        S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
+        I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+        . S @ODIRGLB="/home/glilly/CCROUT"
+        . ;S @ODIRGLB="/home/cedwards/"
+        . ;S @ODIRGLB="/opt/wv/p/"
+        S ODIR=DIR
+        I DIR="" S ODIR=@ODIRGLB
+        N ZY
+        S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
+        W $P(ZY,U,2)
+        Q
+        ;
 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)   ;RPC ENTRY POINT FOR CCR OUTPUT
-           ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-           ; DFN IS PATIENT IEN
-           ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-           ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-           ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-           ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-           ; - NULL MEANS NOW
-           ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-           ;    "TO" VARIABLES
-           ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
-           I '$D(DEBUG) S DEBUG=0
-           N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
-           I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
-           S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-           I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
-           E  S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-           S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-           ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-           S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-           I CCD D LOAD^C0CCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-           E  D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-           D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-           N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
-           S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
-           S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
-           S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
-           S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
-           S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
-           S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
-           ;
-           ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-           ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-           D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
-           D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
-           I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
-           I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
-           ;
-           I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-           ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
-           S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
-           D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
-           D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
-           I DEBUG D PARY^C0CXPATH("ACTT2")
-           D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
-           I DEBUG D PARY^C0CXPATH(CCDGLO)
-           K ACTT1 K ACCT2
-           ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
-           ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
-           D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
-           D CP^C0CXPATH("ACTT2",CCDGLO)
-           ;
-           K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-           S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-           D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-           N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-           F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-           . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
-           . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-           . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-           . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-           . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-           . S IXML="INXML"
-           . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
-           . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-           . ; W OXML,!
-           . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-           . W "RUNNING ",CALL,!
-           . X CALL
-           . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-           . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
-           . . I CCD D UNSHAVE("ITMP",OXML)
-           . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
-           . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-           . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
-           . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
-           ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
-           ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
-           ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-           ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
-           ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-           N I,J,DONE S DONE=0
-           F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-           . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
-           . W "TRIMMED",J,!
-           . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-           I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
-           . N I
-           . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
-           . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
-           . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
-           . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
-           . . . S @CCDGLO@(I)="</structuredBody></component>"
-           S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
-           S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
-           Q
-           ;
+        ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+        ; DFN IS PATIENT IEN
+        ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+        ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+        ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+        ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+        ; - NULL MEANS NOW
+        ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+        ;    "TO" VARIABLES
+        ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+        I '$D(DEBUG) S DEBUG=0
+        N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+        I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+        S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+        I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+        E  S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+        S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+        ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+        S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+        I CCD D LOAD^C0CCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+        E  D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+        D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+        N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+        S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+        S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+        S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+        S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+        S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+        S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+        ;
+        ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+        ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+        D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+        D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+        I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+        I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+        ;
+        I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+        ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+        S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+        D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
+        D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+        I DEBUG D PARY^C0CXPATH("ACTT2")
+        D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
+        I DEBUG D PARY^C0CXPATH(CCDGLO)
+        K ACTT1 K ACCT2
+        ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+        ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+        D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+        D CP^C0CXPATH("ACTT2",CCDGLO)
+        ;
+        K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+        S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+        D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+        N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+        F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+        . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+        . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+        . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+        . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+        . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+        . S IXML="INXML"
+        . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+        . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+        . ; W OXML,!
+        . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+        . W "RUNNING ",CALL,!
+        . X CALL
+        . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+        . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+        . . I CCD D UNSHAVE("ITMP",OXML)
+        . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+        . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+        . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+        . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
+        ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+        ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+        ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+        ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
+        ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+        N I,J,DONE S DONE=0
+        F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+        . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+        . W "TRIMMED",J,!
+        . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+        I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+        . N I
+        . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+        . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+        . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+        . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+        . . . S @CCDGLO@(I)="</structuredBody></component>"
+        S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+        S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+        Q
+        ;
 INITSTPS(TAB)    ; INITIALIZE CCR PROCESSING STEPS
-           ; TAB IS PASSED BY NAME
-           W "TAB= ",TAB,!
-           ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-           D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
-           ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
-           I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
-           Q
-           ;
+        ; TAB IS PASSED BY NAME
+        W "TAB= ",TAB,!
+        ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
+        ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
+        I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
+        Q
+        ;
 SHAVE(SHXML)    ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
-           ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
-           N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
-           W SHXML,!
-           W @SHXML@(1),!
-           D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
-           D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
-           D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
-           D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
-           D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
-           D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
-           Q
-           ;
+        ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+        N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+        W SHXML,!
+        W @SHXML@(1),!
+        D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+        D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+        D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+        D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
+        D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+        D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+        Q
+        ;
 UNSHAVE(ORIGXML,SHXML)  ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
-           ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
-           N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
-           W SHXML,!
-           W @SHXML@(1),!
-           D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
-           D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
-           D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
-           D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
-           D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
-           D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
-           Q
-           ;
+        ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+        N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+        W SHXML,!
+        W @SHXML@(1),!
+        D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+        D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+        D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+        D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
+        D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+        D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+        Q
+        ;
 HDRMAP(CXML,DFN,IHDR)     ; MAP HEADER VARIABLES: FROM, TO ECT
-           N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
-           ; K @VMAP
-           S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
-           I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-           . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-           . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-           . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-           . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-           . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-           . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-           . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-           I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-           . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-           N CTMP
-           D MAP^C0CXPATH(CXML,VMAP,"CTMP")
-           D CP^C0CXPATH("CTMP",CXML)
-           Q
-           ;
+        N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
+        ; K @VMAP
+        S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
+        I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+        . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+        . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+        . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+        . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+        . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+        . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+        . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+        I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+        . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+        N CTMP
+        D MAP^C0CXPATH(CXML,VMAP,"CTMP")
+        D CP^C0CXPATH("CTMP",CXML)
+        Q
+        ;
 ACTLST(AXML,ACTRTN)     ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-           ; AXML AND ACTRTN ARE PASSED BY NAME
-           ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-           ; P1= OBJECTID - ACTORPATIENT_2
-           ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-           ;OR INSTITUTION
-           ;  OR PERSON(IN PATIENT FILE IE NOK)
-           ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-           N I,J,K,L
-           K @ACTRTN ; CLEAR RETURN ARRAY
-           F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-           . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-           . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-           . . W "<ActorID>=>",J,!
-           . . I J'="" S K(J)="" ; HASHING ACTOR
-           . . ;  TO GET RID OF DUPLICATES
-           S I="" ; GOING TO $O THROUGH THE HASH
-           F J=0:0 D  Q:$O(K(I))=""  ;
-           . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-           . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-           . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-           . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-           . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-           Q
-           ;
+        ; AXML AND ACTRTN ARE PASSED BY NAME
+        ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+        ; P1= OBJECTID - ACTORPATIENT_2
+        ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+        ;OR INSTITUTION
+        ;  OR PERSON(IN PATIENT FILE IE NOK)
+        ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+        N I,J,K,L
+        K @ACTRTN ; CLEAR RETURN ARRAY
+        F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+        . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+        . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+        . . W "<ActorID>=>",J,!
+        . . I J'="" S K(J)="" ; HASHING ACTOR
+        . . ;  TO GET RID OF DUPLICATES
+        S I="" ; GOING TO $O THROUGH THE HASH
+        F J=0:0 D  Q:$O(K(I))=""  ;
+        . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+        . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+        . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+        . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+        . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+        Q
+        ;
 TEST    ; RUN ALL THE TEST CASES
-         D TESTALL^C0CUNIT("C0CCCR")
-         Q
-         ;
+        D TESTALL^C0CUNIT("C0CCCR")
+        Q
+        ;
 ZTEST(WHICH)     ; RUN ONE SET OF TESTS
-         N ZTMP
-         D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
-         D ZTEST^C0CUNIT(.ZTMP,WHICH)
-         Q
-         ;
+        N ZTMP
+        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+        D ZTEST^C0CUNIT(.ZTMP,WHICH)
+        Q
+        ;
 TLIST    ; LIST THE TESTS
-         N ZTMP
-         D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
-         D TLIST^C0CUNIT(.ZTMP)
-         Q
-         ;
+        N ZTMP
+        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+        D TLIST^C0CUNIT(.ZTMP)
+        Q
+        ;
         ;;><TEST>
         ;;><PROBLEMS>

ccr/trunk/p/C0CCCD1.m

@@ -1 +1 @@
 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-        ;
-                 W "This is a CCD TEMPLATE with processing routines",!
-                 W !
-                 Q
-                 ;
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
+        ;
+        W "This is a CCD TEMPLATE with processing routines",!
+        W !
+        Q
+        ;
 ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
-                 ; ZARY IS PASSED BY NAME
-                 ; BAT is a string identifying the section
-                 ; LINE is a test which will evaluate to true or false
-                 ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
-                 ; . S @ZARY@(0)=0 ; initially there are no elements
-                 ; . W "GOT HERE LOADING "_LINE,!
-                 N CNT ; count of array elements
-                 S CNT=@ZARY@(0) ; contains array count
-                 S CNT=CNT+1 ; increment count
-                 S @ZARY@(CNT)=LINE ; put the line in the array
-                 ; S @ZARY@(BAT,CNT)="" ; index the test by battery
-                 S @ZARY@(0)=CNT ; update the array counter
-                 Q
-                 ;
+        ; ZARY IS PASSED BY NAME
+        ; BAT is a string identifying the section
+        ; LINE is a test which will evaluate to true or false
+        ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
+        ; . S @ZARY@(0)=0 ; initially there are no elements
+        ; . W "GOT HERE LOADING "_LINE,!
+        N CNT ; count of array elements
+        S CNT=@ZARY@(0) ; contains array count
+        S CNT=CNT+1 ; increment count
+        S @ZARY@(CNT)=LINE ; put the line in the array
+        ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+        S @ZARY@(0)=CNT ; update the array counter
+        Q
+        ;
 ZLOAD(ZARY,ROUTINE)     ; load tests into ZARY which is passed by reference
-                 ; ZARY IS PASSED BY NAME
-                 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
-                 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
-                 K @ZARY S @ZARY=""
-                 S @ZARY@(0)=0 ; initialize array count
-                 N LINE,LABEL,BODY
-                 N INTEST S INTEST=0 ; switch for in the TEMPLATE section
-                 N SECTION S SECTION="[anonymous]" ; NO section LABEL
-                 ;
-                 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
-                 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
-                 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
-                 . I INTEST  D  ; within the section
-                 . . I LINE?." "1";><".E  D  ; sub-section name found
-                 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
-                 . . I LINE?." "1";;".E  D  ; line found
-                 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
-                 Q
-                 ;
+        ; ZARY IS PASSED BY NAME
+        ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+        ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+        K @ZARY S @ZARY=""
+        S @ZARY@(0)=0 ; initialize array count
+        N LINE,LABEL,BODY
+        N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+        N SECTION S SECTION="[anonymous]" ; NO section LABEL
+        ;
+        N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+        . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+        . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+        . I INTEST  D  ; within the section
+        . . I LINE?." "1";><".E  D  ; sub-section name found
+        . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+        . . I LINE?." "1";;".E  D  ; line found
+        . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+        Q
+        ;
 LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
-                 D ZLOAD(ARY,"C0CCCD1")
-                 ; ZWR @ARY
-                 Q
-                 ;
+        D ZLOAD(ARY,"C0CCCD1")
+        ; ZWR @ARY
+        Q
+        ;
 TRMCCD     ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
-                 Q
+        Q
 MARKUP  ;<MARKUP>
         ;;<Body>

ccr/trunk/p/C0CCCR.m

@@ -1 +1 @@
 C0CCCR    ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ; EXPORT A CCR
@@ -288 +285 @@
         ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
         ;;>>?@C0C@(@C0C@(0))["</Alerts>"
-        
-        

ccr/trunk/p/C0CCCR0.m

@@ -1 +1 @@
 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is a CCR TEMPLATE with processing routines",!

ccr/trunk/p/C0CCMT.m

@@ -1 +1 @@
 C0CCMT   ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2010 George Lilly, University of Minnesota and others.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         W "NO ENTRY FROM TOP",!

ccr/trunk/p/C0CCPT.m

@@ -1 +1 @@
 C0CCPT  ;;BSL;RETURN CPT DATA;
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Sequence Managers Software GPL;;;;;Build 2
-        ;Copied into C0C namespace from SQMCPT with permission from
-        ;Brian Lord - and with our thanks. gpl 01/20/2010
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; (C) George Lilly 2010
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
 ENTRY(DFN,STDT,ENDDT,TXT)       ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
         ;DFN=PATIENT IEN
@@ -10 +22 @@
         ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
         ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 
-               ;ALL INCLUSIVE IN THAT DIRECTION
-               ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
-               ;BUILD INTO NOTE(Y)=""
-               S U="^",X=""
-               F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
-               . S Y=""
-               . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
-               .. S NOTE(Y)=""
-               ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
-               ;GET DATE OF NOTE
+        ;ALL INCLUSIVE IN THAT DIRECTION
+        ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
+        ;BUILD INTO NOTE(Y)=""
+        S U="^",X=""
+        F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
+        . S Y=""
+        . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
+        .. S NOTE(Y)=""
+        ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
+        ;GET DATE OF NOTE
         ;RUT 3120109 Changing DATE in FILMAN's FORMAT
-        ;;OHUM/RUT 3111228 Date Range for Notes
-               ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
+        ;OHUM/RUT 3111228 Date Range for Notes
+        ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
         N FLAGS1,FLAGS2
         S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1)
         S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2)
         ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART")
-               ;;OHUM/RUT
+        ;OHUM/RUT
         ;RUT
-               S Z=""
-               F  S Z=$O(NOTE(Z)) Q:Z=""  D
-               . S DT=$P(^TIU(8925,Z,0),U,7)
-               . I $G(STDT)]"" D
-               .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
-               . I $G(ENDDT)]"" D
-               .. I ENDDT<DT S NOTE(Z)="D"
-               . I NOTE(Z)="D" K NOTE(Z)
+        S Z=""
+        F  S Z=$O(NOTE(Z)) Q:Z=""  D
+        . S DT=$P(^TIU(8925,Z,0),U,7)
+        . I $G(STDT)]"" D
+        .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
+        . I $G(ENDDT)]"" D
+        .. I ENDDT<DT S NOTE(Z)="D"
+        . I NOTE(Z)="D" K NOTE(Z)
         D VISIT
-               Q
+        Q
 VISIT     ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
         S ILST=1,X0="",X12="",VISIT="",LST="",X811=""

ccr/trunk/p/C0CDIC.m

@@ -1 +1 @@
 C0CDIC    ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is the CCR Dictionary Utility Library ",!

ccr/trunk/p/C0CDOM.m

@@ -1 @@
-C0CDOM   ; GPL - DOM PROCESSING ROUTINES ;6/6/11  17:05
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-        ;
-        Q
-        ;
-DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
+C0CDOM    ; GPL - DOM PROCESSING ROUTINES ;6/6/11  17:05
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2011 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
+        ;
+        Q
+        ;
+DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
         ; THE XPATH INDEX ZXIDX, PASSED BY NAME
         ; THE XPATH ARRAY XPARY, PASSED BY NAME
@@ -82 +81 @@
         Q
         ;
-PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
+PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
         ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
         ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
@@ -88 +87 @@
         Q $$EN^MXMLDOM(INXML,"W")
         ;
-ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
         N ZN
         ;I $$TAG(ZOID)["entry" B
@@ -95 +94 @@
         Q 0
         ;
-FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
         Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
         ;
-PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+PARENT(ZOID)    ;RETURNS THE OID OF THE PARENT OF ZOID
         Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
         ;
-ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
+ATT(RTN,NODE)   ;GET ATTRIBUTES FOR ZOID
         S HANDLE=C0CDOCID
         K @RTN
@@ -107 +106 @@
         Q
         ;
-TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
+TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
         ;I ZOID=149 B ;GPLTEST
         N X,Y
@@ -116 +115 @@
         Q Y
         ;
-NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
+NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
         Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
         ;
-DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
+DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
         ;N ZT,ZN S ZT=""
         ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
@@ -126 +125 @@
         Q
         ;
-OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
+OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
         ;
         S C0CDOCID=INID
@@ -137 +136 @@
         Q
         ;
-NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
+NDOUT(ZOID)     ;CALLBACK ROUTINE - IT IS RECURSIVE
         N ZI S ZI=$$FIRST(ZOID)
         I ZI'=0 D  ; THERE IS A CHILD

ccr/trunk/p/C0CDPT.m

@@ -1 +1 @@
 C0CDPT  ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;
-        ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License. 
-        ; 
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; Copyright 2008 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ; 
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         ; FAMILY       Family Name

ccr/trunk/p/C0CENC.m

@@ -1 +1 @@
 C0CENC   ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2010 George Lilly, University of Minnesota and others.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -155 +152 @@
         ; CPT^CATEGORY^TEXT
         N Z1,Z2,Z3,ZRTN
-        S Z1=$P(ISTR,U,1) 
+        S Z1=$P(ISTR,U,1)
         I Z1="" D  ;
         . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)

ccr/trunk/p/C0CENV.m

@@ -1 +1 @@
 C0CENV  ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; (C) John McCormack 2009
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ;

ccr/trunk/p/C0CEVC.m

@@ -1 @@
-C0CEVC   ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
-        ;;1.2;C0C;;May 11, 2012;Build 47
+C0CEVC    ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; (C) Geroge Lilly 2010.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
 gpltest2        ; experiment with sending a CCR to an ewd page
         N ZI

ccr/trunk/p/C0CEWD.m

@@ -1 +1 @@
 C0CEWD    ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ;Copyright 2011 George Lilly.  
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q

ccr/trunk/p/C0CEWD1.m

@@ -1 +1 @@
 C0CEWD1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q

ccr/trunk/p/C0CFM1.m

@@ -1 +1 @@
 C0CFM1    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         W "This is the CCR FILEMAN Utility Library ",!
@@ -69 +68 @@
         K ZERR
         D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-        I $D(ZERR) B  ;OOPS
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))

ccr/trunk/p/C0CFM2.m

@@ -1 +1 @@
 C0CFM2    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         W "This is the CCR FILEMAN Utility Library ",!
@@ -149 +148 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q
@@ -183 +179 @@
         . . W ZCHK,!
         . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
-        ZWR ^TMP("C0CCHK",ZPAT,*)
+        ; ZWR ^TMP("C0CCHK",ZPAT,*)
         Q
         ;
@@ -224 +220 @@
         Q
         ; 
-PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+PUTELSO(DFN,ZTYPE,ZOCC,ZVALS)   ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
         ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
         ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
@@ -249 +245 @@
         ;B
         D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-        I $D(ZERR) B  ;OOPS
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
         W "RECORD NUMBER: ",ZD0,!
-        ;B
         S ZCNT=0
         S ZC0CI="" ;
@@ -271 +266 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q

ccr/trunk/p/C0CFM3.m

@@ -1 +1 @@
 C0CFM3    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         W "This is the CCR FILEMAN Utility Library ",!
@@ -135 +134 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
-        K C0CFDA
-        Q
-        ;
-PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+        I $D(ZERR) S $EC=",U1,"
+        K C0CFDA
+        Q
+        ;
+PUTELSO(DFN,ZTYPE,ZOCC,ZVALS)   ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
         ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
         ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
@@ -167 +163 @@
         ;B
         D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-        I $D(ZERR) B  ;OOPS
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
@@ -189 +185 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q
@@ -283 +276 @@
         N ZG
         S ZG=""
-        F  S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG=""  D  ZWR ^C0CE4(ZG,*)
-        Q
-        ;
+        F  S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG=""  D
+        . ; ZWR ^C0CE4(ZG,*)
+        Q
+        ;

ccr/trunk/p/C0CIM2.m

@@ -1 +1 @@
 C0CIM2   ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2010 George Lilly, University of Minnesota and others.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!

ccr/trunk/p/C0CIMMU.m

@@ -1 +1 @@
 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR

ccr/trunk/p/C0CIN.m

@@ -1 +1 @@
 C0CIN     ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is the CCR Import Utility Library ",!
@@ -185 +183 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q

ccr/trunk/p/C0CLA7DD.m

@@ -1 @@
-C0CLA7DD        ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009
-        ;;1.2;C0C;;May 11, 2012;Build 47
- ;
+C0CLA7DD        ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 ; 10/30/12 10:16am
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; (C) 2009 John McCormack
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file.
- ;
+        ;
         Q
         ;
@@ -249 +263 @@
         ;
         ;
-SENDXQA(MSG) ; Send alert for reindex status
- ;
- N XQA,XQAMSG
- ;
- S XQA(DUZ)=""
- S XQAMSG=MSG
- D SETUP^XQALERT
- ;
- Q
+SENDXQA(MSG)    ; Send alert for reindex status
+        ;
+        N XQA,XQAMSG
+        ;
+        S XQA(DUZ)=""
+        S XQAMSG=MSG
+        D SETUP^XQALERT
+        ;
+        Q

ccr/trunk/p/C0CLA7Q.m

@@ -1 @@
-C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009
-        ;;1.2;C0C;;May 11, 2012;Build 47
+C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 ; 10/30/12 10:16am
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; (C) 2009 John McCormack
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ;

ccr/trunk/p/C0CLABS.m

@@ -1 +1 @@
 C0CLABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ; 5/10/12 2:49pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-                  ;
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
 MAP(MIXML,DFN,MOXML)    ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
         ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
@@ -64 +61 @@
         I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
         . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
-        I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
+        I @C0CV@(0)=0 S RTN(0)=0 Q  ; NO RESULTS
         S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
         K @RIMVARS
@@ -107 +104 @@
         . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
         . ;I C0CI=1 D  ; FIRST TIME, COPY INSTEAD OF INSERT
-        . . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;
+        . ;. D CP^C0CXPATH(C0CRTMP,"RTN") ;
         . ;E  D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
         D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>

ccr/trunk/p/C0CMAIL.m

@@ -1 @@
-C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
-V       ;;1.2;C0C;;May 11, 2012;Build 47
+C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
+V       ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2011 Chris Richardson, Richardson Computer Research
         ; Modified 3110516@1818
         ;   rcr@rcresearch.us
-        ;  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ;  ------------------

ccr/trunk/p/C0CMAIL2.m

@@ -1 +1 @@
 C0CMAIL2        ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr  ; 5/10/12 2:50pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2011 Chris Richardson, Richardson Computer Research
         ; Modified 3110615@1040
         ;   rcr@rcresearch.us
-        ;  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ;  ------------------

ccr/trunk/p/C0CMAIL3.m

@@ -1 +1 @@
 C0CMAIL3        ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr   ; 5/10/12 2:51pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2011 Chris Richardson, Richardson Computer Research
         ; Modified 3110619@2038
         ;   rcr@rcresearch.us
-        ;  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ;  ------------------

ccr/trunk/p/C0CMCCD.m

@@ -1 @@
-C0CMCCD   ; GPL - MXML based CCD utilities;12/04/09  17:05
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+C0CMCCD   ; GPL - MXML based CCD utilities;12/04/09  17:05
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q
@@ -281 +279 @@
         Q
         ; 
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
         K ZERR
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q

ccr/trunk/p/C0CMED.m

@@ -1 +1 @@
 C0CMED  ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
-        ; Licensed under the terms of the GNU General Public License.
-        ; See attached copy of the License.
-        ; 
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
-        ; 
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ; 
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         ; --Revision History
@@ -53 +51 @@
         I $$RPMS^C0CUTIL() D RPMS QUIT
         I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
-RPMS    
+RPMS    ;
         ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
         N MEDCOUNT S MEDCOUNT=0
@@ -62 +60 @@
         D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
         D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
-        I @HIST@(0)>0 D  
+        I @HIST@(0)>0 D
         . D CP^C0CXPATH(HIST,MEDOUTXML)
         . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
-        I @NVA@(0)>0 D 
-        . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
+        I @NVA@(0)>0 D
+        . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
         . ;E  D CP^C0CXPATH(NVA,MEDOUTXML) 
         . W:$G(DEBUG) "HAS NON-VA MEDS",!
         Q
-VISTA   
+VISTA   ; 
         N MEDCOUNT S MEDCOUNT=0
         K ^TMP($J,"MED")
@@ -88 +86 @@
         D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
         D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
-        I @HIST@(0)>0 D  
+        I @HIST@(0)>0 D
         . D CP^C0CXPATH(HIST,MEDOUTXML)
         . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
-        I @PEND@(0)>0 D  
+        I @PEND@(0)>0 D
         . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
         . E  D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
         . W:$G(DEBUG) "HAS OP PENDING MEDS",!
-        I @NVA@(0)>0 D 
-        . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
-        . E  D CP^C0CXPATH(NVA,MEDOUTXML) 
+        I @NVA@(0)>0 D
+        . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
+        . E  D CP^C0CXPATH(NVA,MEDOUTXML)
         . W:$G(DEBUG) "HAS NON-VA MEDS",!
-        I @IPUD@(0)>0 D 
-        . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD) 
-        . E  D CP^C0CXPATH(IPUD,MEDOUTXML) 
+        I @IPUD@(0)>0 D
+        . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD)
+        . E  D CP^C0CXPATH(IPUD,MEDOUTXML)
         . W:$G(DEBUG) "HAS INPATIENT MEDS",!
         N ZI
@@ -112 +110 @@
         K @IPUD
         Q
-        

ccr/trunk/p/C0CMED1.m

@@ -1 +1 @@
 C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;;Last modified Sat Jan 10 21:42:27 PST 2009
-        ; Copyright 2009 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License See attached copy of the License.
-        ;
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
+        ; Copyright 2009 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ;
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -58 +56 @@
         ; If it is -1, we quit.
         I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q
-        ZWRITE:$G(DEBUG) MEDS
+        ; ZWRITE:$G(DEBUG) MEDS
         N RXIEN S RXIEN=0
         F  S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)=""  D  ; FOR EACH MEDICATION IN THE LIST
         . N MED M MED=MEDS(RXIEN)
         . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
-        . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
+        . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT  ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
         . S MEDCOUNT=MEDCOUNT+1
         . W:$G(DEBUG) "RXIEN IS ",RXIEN,!

ccr/trunk/p/C0CMED2.m

@@ -1 +1 @@
 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;;Last Modified Sat Jan 10 21:41:14 PST 2009
-        ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License See attached copy of the License.
-        ;
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
+        ; Copyright 2008 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ;
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -48 +46 @@
         ; If it is -1, we quit.
         I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-        ZWRITE:$G(DEBUG) MEDS
+        ; ZWRITE:$G(DEBUG) MEDS
         N RXIEN S RXIEN=0
         N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING

ccr/trunk/p/C0CMED3.m

@@ -1 +1 @@
 C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
-        ; Copyright 2009 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License See attached copy of the License.
-        ;
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
+        ; Copyright 2009 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ;
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -49 +47 @@
         K NVA
         ;
-        I DEBUG ZWRITE MEDS
+        ; I DEBUG ZWRITE MEDS
         N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
         N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE

ccr/trunk/p/C0CMED4.m

@@ -1 +1 @@
 C0CMED4         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:38pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; Copyright 2008 WorldVistA.  
         ;
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
+        ; GNU Affero General Public License for more details.
         ;
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -49 +47 @@
         ; Otherwise, we go on...
         M MEDS=^TMP($J,"UD")
-        I DEBUG ZWR MEDS
-        S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 
+        ; I DEBUG ZWR MEDS
+        S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
         N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
-        N I S I=0 
+        N I S I=0
         F  S I=$O(MEDS("B",I)) Q:'I  D  ; For each medication in B index
         . N MED M MED=MEDS(I)
@@ -61 +59 @@
         . I DEBUG W "RXIEN IS ",RXIEN,!
         . I DEBUG W "MAP= ",MAP,!
-        . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
+        . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
         . S @MAP@("MEDISSUEDATETXT")="Order Date"
         . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
@@ -70 +68 @@
         . S @MAP@("MEDTYPETEXT")="Medication"
         . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-        . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
+        . S @MAP@("MEDSTATUSTEXT")="ACTIVE"
         . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
         . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
@@ -114 +112 @@
         . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
         . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-          E  S @MAP@("MEDQUANTITYUNIT")=""
+        . E  S @MAP@("MEDQUANTITYUNIT")=""
         . ;
         . ; --- START OF DIRECTIONS ---
@@ -126 +124 @@
         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
-        . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""  
-        . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""  
-        . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""  
+        . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
+        . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
+        . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
@@ -143 +141 @@
         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-        . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
+        . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""

ccr/trunk/p/C0CMED6.m

@@ -1 +1 @@
 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License See attached copy of the License.
-        ;
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; Copyright 2008 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ;
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -55 +53 @@
         ; If MEDS1 is not defined, then no meds
         I '$D(MEDS1) QUIT
-        I DEBUG ZWR MEDS1,MINXML
+        ;I DEBUG ZWR MEDS1,MINXML
         N MEDCNT S MEDCNT=0 ; Med Count
         ; The next line is a super line. It goes through the array return
@@ -229 +227 @@
         . . N INTERVAL S INTERVAL="" ; Default
         . . ; If there are entries found, get it
-        . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 
+        . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2)
         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
@@ -265 +263 @@
         . ; -- 1. Med Patient Instructions
         . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
-        . N MEDPTIN2,J  S (MEDPTIN2,J)="" 
+        . N MEDPTIN2,J  S (MEDPTIN2,J)=""
         . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
         . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
@@ -312 +310 @@
         N RXNORM,C0CZRXN,DIERR
         D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
-        I $D(DIERR) D ^%ZTER BREAK
+        I $D(DIERR) S $EC=",U1,"
         S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
         N I S I=0
@@ -329 +327 @@
         . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
         QUIT +$G(RXNORM)  ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
-        

ccr/trunk/p/C0CMIME.m

@@ -1 +1 @@
 C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q
@@ -45 +43 @@
         Q
         ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN
-ENCODEOLD(IARY,LRNODE,LRSTR)    ; Encode a string, keep remainder for next line
+ENCODEO(IARY,LRNODE,LRSTR)      ; Encode a string, keep remainder for next line
         ; Call with LRSTR by reference, Remainder returned in LRSTR
         ; IARY IS PASSED BY NAME
@@ -70 +68 @@
         S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
         D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH)
-        ZWR GR
-        Q
-        ;
-TESTMAIL2       ;
+        ; ZWR GR
+        Q
+        ;
+TESTMAI2        ;
         ; TEST OF MAILSEND TO gpl.mdc-crew.net
         N C0CGM
@@ -85 +83 @@
         ;S ZTO("george@nhin.openforum.opensourcevista.net")=""
         ;S ZTO("mish@nhin.openforum.opensourcevista.net")="" 
-        S ZTO("brooks.richard@securemail.opensourcevista.net")="" 
+        S ZTO("brooks.richard@securemail.opensourcevista.net")=""
         ;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
         ;S ZTO("ncoal@live.com")=""
@@ -99 +97 @@
         S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
         D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")
-        ZWR GR
+        ; ZWR GR
         Q
         ;
@@ -203 +201 @@
         Q
         ;
-MAILSEND0(LRMSUBJ)      ; Send extract back to requestor.
+MAILSEN0(LRMSUBJ)       ; Send extract back to requestor.
         ;
         ;D TEST
@@ -251 +249 @@
         Q
         ;
-MAILSEND2(UDFN,ADDR)    ; Send extract back to requestor.
+MAILSEN2(UDFN,ADDR)     ; Send extract back to requestor.
         ;
         I +$G(UDFN)=0 S UDFN=2 ;

ccr/trunk/p/C0CMXML.m

@@ -1 +1 @@
 C0CMXML   ; GPL - MXML based XPath utilities;10/13/09  17:05
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q
@@ -45 +43 @@
         Q
         ;
-TEST3   
+TEST3   ;
         S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
         K GARY,GTMP,GIDX
@@ -114 +112 @@
         D END^C0CMXMLB ;END THE DOCUMENT
         M ZCCR=^TMP("MXMLBLD",$J)
-        ZWR ZCCR
+        ; ZWR ZCCR
         Q
         ;
@@ -137 +135 @@
         ;D END^C0CMXMLB ;EOND THE DOCUMENT
         ;M ZCCD=^TMP("MXMLBLD",$J)
-        ZWR ZCCD(1:30)
+        ; ZWR ZCCD(1:30)
         Q
         ; 
@@ -246 +244 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q

ccr/trunk/p/C0CMXMLB.m

@@ -1 +1 @@
 C0CMXMLB        ;;ISF/RWF - Tool to build XML ; 5/10/12 2:51pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         QUIT
+        ;
+        ; FOIA Routine - Public Domain
         ;
         ;DOC - The top level tag
@@ -10 +12 @@
         S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
         I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
-        I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 
+        I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
         D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
         Q

ccr/trunk/p/C0CMXP.m

@@ -1 +1 @@
 C0CMXP    ; GPL - MXML based XPath utilities;12/04/09  17:05
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q
@@ -167 +165 @@
         S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
         K @C0CXLOC
-        S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 
+        S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
         ;N GIDX,GIDX2,GARY,GARY2
         I '$D(REDUX) S REDUX=""
@@ -284 +282 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q

ccr/trunk/p/C0CNHIN.m

@@ -1 @@
-C0CNHIN   ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11  17:05
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+C0CNHIN   ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11  17:05
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2011 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q
@@ -146 +144 @@
         Q
         ;
-DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
+DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
         ; THE XPATH INDEX ZXIDX, PASSED BY NAME
         ; THE XPATH ARRAY XPARY, PASSED BY NAME
@@ -205 +203 @@
         Q
         ;
-PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
+PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
         ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
         ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
@@ -211 +209 @@
         Q $$EN^MXMLDOM(INXML,"W")
         ;
-ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
         N ZN
         ;I $$TAG(ZOID)["entry" B
@@ -218 +216 @@
         Q 0
         ;
-FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
         Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
         ;
-PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+PARENT(ZOID)    ;RETURNS THE OID OF THE PARENT OF ZOID
         Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
         ;
-ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
+ATT(RTN,NODE)   ;GET ATTRIBUTES FOR ZOID
         S HANDLE=C0CDOCID
         K @RTN
@@ -230 +228 @@
         Q
         ;
-TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
+TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
         ;I ZOID=149 B ;GPLTEST
         N X,Y
@@ -239 +237 @@
         Q Y
         ;
-NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
+NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
         Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
         ;
-DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
+DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
         ;N ZT,ZN S ZT=""
         ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
@@ -249 +247 @@
         Q
         ;
-OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
+OUTXML(ZRTN,INID)       ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
         ;
         S C0CDOCID=INID
@@ -259 +257 @@
         Q
         ;
-NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
+NDOUT(ZOID)     ;CALLBACK ROUTINE - IT IS RECURSIVE
         N ZI S ZI=$$FIRST(ZOID)
         I ZI'=0 D  ; THERE IS A CHILD

ccr/trunk/p/C0CNMED2.m

@@ -1 +1 @@
 C0CNMED2        ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 ; 5/10/12 2:53pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
-        ; Licensed under the terms of the GNU General Public License.
-        ; See attached copy of the License.
-        ; 
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
-        ; 
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ; 
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         ; --Revision History

ccr/trunk/p/C0CNMED4.m

@@ -1 +1 @@
 C0CNMED4        ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License See attached copy of the License.
-        ;
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; Copyright 2008 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ;
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -58 +56 @@
         IF ZCOUNT=0 Q  ; no inpatient meds
         ;M MEDS=^TMP($J,"UD")
-        I DEBUG ZWR MEDS
-        S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 
+        ;I DEBUG ZWR MEDS
+        S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
         ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
         S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG
-        N I S I=0 
+        N I S I=0
         F  S I=$O(MEDS("med",I)) Q:'I  D  ; For each medication
         . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT
-               . I ($P(C0CMFLAG,"^",1)'=1) D
-               . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
-               . . . K MEDS("med",I) Q
-               . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
-               . . . K MEDS("med",I) Q
-               . ;OHUM/RUT
+        . I ($P(C0CMFLAG,"^",1)'=1) D
+        . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
+        . . . K MEDS("med",I) Q
+        . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
+        . . . K MEDS("med",I) Q
+        . ;OHUM/RUT
         . N MED M MED=MEDS("med",I)
         . I $G(MED("vaType@value"))'="I" Q  ; not inpatient
@@ -80 +78 @@
         . I DEBUG W "RXIEN IS ",RXIEN,!
         . I DEBUG W "MAP= ",MAP,!
-        . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
+        . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
         . S @MAP@("MEDISSUEDATETXT")="Order Date"
         . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
@@ -174 +172 @@
         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
-        . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""  
-        . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""  
-        . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""  
+        . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
+        . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
+        . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
@@ -191 +189 @@
         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-        . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
+        . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
         . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""

ccr/trunk/p/C0CORSLT.m

@@ -1 +1 @@
 C0CORSLT        ; CCDCCR/GPL - CCR/CCD PROCESSING ADDITIONAL RESULTS ; 06/27/11
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2011 George Lilly.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!

ccr/trunk/p/C0COVREL.m

@@ -1 +1 @@
 C0COVREL        ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
-               ;;1.2;C0C;;May 11, 2012;Build 47
-LIST       ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
-               N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
-               I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-               I '$D(C0CQT) S C0CQT=0
-               I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
-               I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
-               I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
-               I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
-               S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
-               S C0CHB=$NA(^TMP("HLS",$J))
-               S C0CI=""
-               S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
-               F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
-               . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
-               . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
-               . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
-               . M XV=C0CVAR ;
-               . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
-               . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
-               . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
-               . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
-               . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
-               . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
-               . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
-               . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
-               . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-               . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-               . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
-               . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
-               . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX
-               . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
-               . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
-               . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
-               . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
-               . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
-               . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
-               . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
-               . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
-               . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
-               . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
-               . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
-               . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
-               . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
-               . . E  D  ; NO SECONDARY, USE PRIMARY
-               . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
-               . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
-               . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
-               . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
-               . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
-               . . S C0CZG=XV("RESULTTESTVALUE")
-               . . S XV("RESULTTESTVALUE")=C0CZG
-               . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
-               . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
-               . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
-               . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
-               . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
-               . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
-               . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
-               . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
-               . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
-               . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
-               . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
-               . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-               . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-               . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
-               . I 'C0CQT D  ;
-               . . W C0CI," ",C0CTYP,!
-               Q
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; (C) ELN 2012
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
+LIST    ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
+        N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
+        I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+        I '$D(C0CQT) S C0CQT=0
+        I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
+        I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
+        I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
+        I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
+        S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
+        S C0CHB=$NA(^TMP("HLS",$J))
+        S C0CI=""
+        S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
+        F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
+        . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
+        . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
+        . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
+        . M XV=C0CVAR ;
+        . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
+        . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
+        . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
+        . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
+        . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
+        . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
+        . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
+        . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
+        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+        . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+        . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
+        . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
+        . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX
+        . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
+        . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
+        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
+        . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
+        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
+        . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
+        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
+        . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
+        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
+        . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
+        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
+        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
+        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
+        . . E  D  ; NO SECONDARY, USE PRIMARY
+        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
+        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
+        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
+        . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
+        . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
+        . . S C0CZG=XV("RESULTTESTVALUE")
+        . . S XV("RESULTTESTVALUE")=C0CZG
+        . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
+        . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+        . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+        . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+        . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+        . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+        . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
+        . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
+        . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
+        . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+        . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
+        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+        . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+        . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+        . I 'C0CQT D  ;
+        . . W C0CI," ",C0CTYP,!
+        Q

ccr/trunk/p/C0COVRES.m

@@ -1 +1 @@
 C0COVRES        ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
-               ;;1.2;C0C;;May 11, 2012;Build 47
-               ;
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; (C) ELN 2012
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
 MAP(MIXML,DFN,MOXML)       ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
-               ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
-               ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
-               ; MIXML IS THE TEMPLATE TO USE
-               ; MOXML IS THE OUTPUT XML ARRAY
-               ; DFN IS THE PATIENT RECORD NUMBER
-               N C0COXML,C0CO,C0CV,C0CIXML
-               I '$D(MIVAR) S C0CV="" ;DEFAULT
-               E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
-               I '$D(MIXML) S C0CIXML="" ;DEFAULT
-               E  S C0CIXML=MIXML ;PASSED INPUT XML
-               D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
-               I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
-               E  S C0CO=MOXML
-               M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
-               Q
+        ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
+        ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
+        ; MIXML IS THE TEMPLATE TO USE
+        ; MOXML IS THE OUTPUT XML ARRAY
+        ; DFN IS THE PATIENT RECORD NUMBER
+        N C0COXML,C0CO,C0CV,C0CIXML
+        I '$D(MIVAR) S C0CV="" ;DEFAULT
+        E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
+        I '$D(MIXML) S C0CIXML="" ;DEFAULT
+        E  S C0CIXML=MIXML ;PASSED INPUT XML
+        D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
+        I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
+        E  S C0CO=MOXML
+        M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
+        Q
 RPCMAP(RTN,DFN,RMIVAR,RMIXML)   ; RPC ENTRY POINT FOR MAPPING RESULTS
-               ; RTN IS PASSED BY REFERENCE
-               N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
-               N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
-               I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
-               I RMIXML="" D  ; INPUT XML NOT PASSED
-               . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
-               . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
-               . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
-               E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
-               I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
-               . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
-               E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
-               D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
-               D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
-               D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
-               D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
-               D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
-               ;OHUM/RUT 3111221
-               ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
-               I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
-               ;OHUM/RUT
-               I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
-               . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
-               ; NO RESULTS
-               I @C0CV@(0)=0 S RTN(0)=0 Q
-               S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
-               K @RIMVARS
-               ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
-               N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
-               S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
-               N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
-               N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
-               N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
-               ; TO IMPROVE PERFORMANCE
-               D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
-               F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
-               . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
-               . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
-               . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
-               . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
-               . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
-               . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
-               . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
-               . . K C0CTO ; CLEAR OUTPUT VARIABLE
-               . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
-               . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
-               . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
-               . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
-               . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
-               . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
-               . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
-               . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
-               . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
-               . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
-               D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
-               D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
-               K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
-               Q
+        ; RTN IS PASSED BY REFERENCE
+        N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
+        N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
+        I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
+        I RMIXML="" D  ; INPUT XML NOT PASSED
+        . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
+        . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
+        . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
+        E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
+        I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
+        . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
+        E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
+        D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
+        D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
+        D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
+        D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
+        D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
+        ;OHUM/RUT 3111221
+        ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
+        I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
+        ;OHUM/RUT
+        I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
+        . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
+        ; NO RESULTS
+        I @C0CV@(0)=0 S RTN(0)=0 Q
+        S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
+        K @RIMVARS
+        ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
+        N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
+        S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
+        N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
+        N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
+        N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
+        ; TO IMPROVE PERFORMANCE
+        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
+        F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
+        . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
+        . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
+        . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
+        . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
+        . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
+        . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
+        . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
+        . . K C0CTO ; CLEAR OUTPUT VARIABLE
+        . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
+        . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
+        . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
+        . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
+        . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
+        . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
+        . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
+        . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
+        . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
+        . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
+        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
+        D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
+        K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+        Q
 EXTRACT(ILXML,DFN,OLXML)        ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
-               ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-               N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
-               S C0CNSSN=0
-               S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-               D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
-               I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
-               . S @C0CLB@(0)=0
-               ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
-               N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
-               S C0CQT=1 ; SURPRESS LISTING
-               D LIST^C0COVREL ; EXTRACT THE VARIABLES
-               S C0CQT=QTSAV ; RESET SILENT FLAG
-               K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
-               I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
-               Q
+        ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+        N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
+        S C0CNSSN=0
+        S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+        D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
+        I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
+        . S @C0CLB@(0)=0
+        ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+        N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
+        S C0CQT=1 ; SURPRESS LISTING
+        D LIST^C0COVREL ; EXTRACT THE VARIABLES
+        S C0CQT=QTSAV ; RESET SILENT FLAG
+        K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
+        I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+        Q

ccr/trunk/p/C0COVREU.m

@@ -1 +1 @@
 C0COVREU        ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
-               ;;1.2;C0C;;May 11, 2012;Build 47
-               ;
-               ;
-GHL7       ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
-               N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
-               ; SET UP FOR LAB API CALL
-               S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
-               I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
-               . W "LAB LOOKUP FAILED, NO SSN",!
-               . S C0CNSSN=1 ; SET NO SSN FLAG
-               S C0CSPC="*" ; LOOKING FOR ALL LABS
-               ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
-               ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
-               ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
-               ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
-               S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
-               S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
-               D DT^DILF(,C0CLLMT,.C0CSDT) ;
-               W "LAB LIMIT: ",C0CLLMT,!
-               D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
-               S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
-               Q
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
+        ;
+GHL7    ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
+        N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
+        ; SET UP FOR LAB API CALL
+        S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
+        I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
+        . W "LAB LOOKUP FAILED, NO SSN",!
+        . S C0CNSSN=1 ; SET NO SSN FLAG
+        S C0CSPC="*" ; LOOKING FOR ALL LABS
+        ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
+        ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
+        ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
+        ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
+        S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
+        S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
+        D DT^DILF(,C0CLLMT,.C0CSDT) ;
+        W "LAB LIMIT: ",C0CLLMT,!
+        D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+        S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
+        Q
 LTYP(OSEG,OTYP,OVARA,OC0CQT)       ;
-               N OI,OI2,OTAB,OTI,OV,OVAR
-               S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
-               I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
-               E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
-               I 1 D  ; FOR HL7 SEGMENT TYPE
-               . S OI="" ; INDEX INTO FIELDS IN SEG
-               . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
-               . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
-               . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
-               . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
-               . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
-               . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
-               . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
-               . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
-               . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
-               . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
-               Q
+        N OI,OI2,OTAB,OTI,OV,OVAR
+        S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
+        I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
+        E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
+        I 1 D  ; FOR HL7 SEGMENT TYPE
+        . S OI="" ; INDEX INTO FIELDS IN SEG
+        . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
+        . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
+        . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
+        . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
+        . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
+        . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
+        . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
+        . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
+        . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
+        . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
+        Q
 LOBX       ;
-               Q
-               ;
+        Q
 OUT(DFN)        ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
-               N GA,GF,GD
-               S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
-               S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
-               S GD=^TMP("C0CCCR","ODIR")
-               W $$OUTPUT^C0CXPATH(GA,GF,GD)
-               Q
+        N GA,GF,GD
+        S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
+        S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
+        S GD=^TMP("C0CCCR","ODIR")
+        W $$OUTPUT^C0CXPATH(GA,GF,GD)
+        Q
 SETTBL   ;
-               K X ; CLEAR X
-               S X("PID","PID1")="1^00104^Set ID - Patient ID"
-               S X("PID","PID2")="2^00105^Patient ID (External ID)"
-               S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
-               S X("PID","PID4")="4^00107^Alternate Patient ID"
-               S X("PID","PID5")="5^00108^Patient's Name"
-               S X("PID","PID6")="6^00109^Mother's Maiden Name"
-               S X("PID","PID7")="7^00110^Date of Birth"
-               S X("PID","PID8")="8^00111^Sex"
-               S X("PID","PID9")="9^00112^Patient Alias"
-               S X("PID","PID10")="10^00113^Race"
-               S X("PID","PID11")="11^00114^Patient Address"
-               S X("PID","PID12")="12^00115^County Code"
-               S X("PID","PID13")="13^00116^Phone Number - Home"
-               S X("PID","PID14")="14^00117^Phone Number - Business"
-               S X("PID","PID15")="15^00118^Language - Patient"
-               S X("PID","PID16")="16^00119^Marital Status"
-               S X("PID","PID17")="17^00120^Religion"
-               S X("PID","PID18")="18^00121^Patient Account Number"
-               S X("PID","PID19")="19^00122^SSN Number - Patient"
-               S X("PID","PID20")="20^00123^Drivers License - Patient"
-               S X("PID","PID21")="21^00124^Mother's Identifier"
-               S X("PID","PID22")="22^00125^Ethnic Group"
-               S X("PID","PID23")="23^00126^Birth Place"
-               S X("PID","PID24")="24^00127^Multiple Birth Indicator"
-               S X("PID","PID25")="25^00128^Birth Order"
-               S X("PID","PID26")="26^00129^Citizenship"
-               S X("PID","PID27")="27^00130^Veteran.s Military Status"
-               S X("PID","PID28")="28^00739^Nationality"
-               S X("PID","PID29")="29^00740^Patient Death Date/Time"
-               S X("PID","PID30")="30^00741^Patient Death Indicator"
-               S X("NTE","NTE1")="1^00573^Set ID - NTE"
-               S X("NTE","NTE2")="2^00574^Source of Comment"
-               S X("NTE","NTE3")="3^00575^Comment"
-               S X("ORC","ORC1")="1^00215^Order Control"
-               S X("ORC","ORC2")="2^00216^Placer Order Number"
-               S X("ORC","ORC3")="3^00217^Filler Order Number"
-               S X("ORC","ORC4")="4^00218^Placer Order Number"
-               S X("ORC","ORC5")="5^00219^Order Status"
-               S X("ORC","ORC6")="6^00220^Response Flag"
-               S X("ORC","ORC7")="7^00221^Quantity/Timing"
-               S X("ORC","ORC8")="8^00222^Parent"
-               S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
-               S X("ORC","ORC10")="10^00224^Entered By"
-               S X("ORC","ORC11")="11^00225^Verified By"
-               S X("ORC","ORC12")="12^00226^Ordering Provider"
-               S X("ORC","ORC13")="13^00227^Enterer's Location"
-               S X("ORC","ORC14")="14^00228^Call Back Phone Number"
-               S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
-               S X("ORC","ORC16")="16^00230^Order Control Code Reason"
-               S X("ORC","ORC17")="17^00231^Entering Organization"
-               S X("ORC","ORC18")="18^00232^Entering Device"
-               S X("ORC","ORC19")="19^00233^Action By"
-               S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
-               S X("OBR","OBR2")="2^00216^Placer Order Number"
-               S X("OBR","OBR3")="3^00217^Filler Order Number"
-               S X("OBR","OBR4")="4^00238^Universal Service ID"
-               S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
-               S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
-               S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
-               S X("OBR","OBR5")="5^00239^Priority"
-               S X("OBR","OBR6")="6^00240^Requested Date/Time"
-               S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
-               S X("OBR","OBR8")="8^00242^Observation End Date/Time"
-               S X("OBR","OBR9")="9^00243^Collection Volume"
-               S X("OBR","OBR10")="10^00244^Collector Identifier"
-               S X("OBR","OBR11")="11^00245^Specimen Action Code"
-               S X("OBR","OBR12")="12^00246^Danger Code"
-               S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
-               S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
-               S X("OBR","OBR15")="15^00249^Specimen Source"
-               S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
-               S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
-               S X("OBR","OBR18")="18^00251^Placers Field 1"
-               S X("OBR","OBR19")="19^00252^Placers Field 2"
-               S X("OBR","OBR20")="20^00253^Filler Field 1"
-               S X("OBR","OBR21")="21^00254^Filler Field 2"
-               S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
-               S X("OBR","OBR23")="23^00256^Charge to Practice"
-               S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
-               S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
-               S X("OBR","OBR26")="26^00259^Parent Result"
-               S X("OBR","OBR27")="27^00221^Quantity/Timing"
-               S X("OBR","OBR28")="28^00260^Result Copies to"
-               S X("OBR","OBR29")="29^00261^Parent Number"
-               S X("OBR","OBR30")="30^00262^Transportation Mode"
-               S X("OBR","OBR31")="31^00263^Reason for Study"
-               S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
-               S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
-               S X("OBR","OBR34")="34^00266^Technician"
-               S X("OBR","OBR35")="35^00267^Transcriptionist"
-               S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
-               S X("OBR","OBR37")="37^01028^Number of Sample Containers"
-               S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
-               S X("OBR","OBR39")="39^01030^Collector.s Comment"
-               S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
-               S X("OBR","OBR41")="41^01032^Transport Arranged"
-               S X("OBR","OBR42")="42^01033^Escort Required"
-               S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
-               S X("OBX","OBX1")="1^00559^Set ID - OBX"
-               S X("OBX","OBX2")="2^00676^Value Type"
-               S X("OBX","OBX3")="3^00560^Observation Identifier"
-               S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
-               S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
-               S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
-               S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
-               S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
-               S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
-               S X("OBX","OBX4")="4^00769^Observation Sub-Id"
-               S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
-               S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
-               S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
-               S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
-               S X("OBX","OBX9")="9^00639^Probability"
-               S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
-               S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
-               S X("OBX","OBX12")="12^00567^Date Last Normal Value"
-               S X("OBX","OBX13")="13^00581^User Defined Access Checks"
-               S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
-               S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
-               S X("OBX","OBX16")="16^00584^Responsible Observer"
-               S X("OBX","OBX17")="17^00936^Observation Method"
-               K ^TMP("C0CCCR","LABTBL")
-               M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
-               S ^TMP("C0CCCR","LABTBL",0)="V3"
-               Q
+        K X ; CLEAR X
+        S X("PID","PID1")="1^00104^Set ID - Patient ID"
+        S X("PID","PID2")="2^00105^Patient ID (External ID)"
+        S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
+        S X("PID","PID4")="4^00107^Alternate Patient ID"
+        S X("PID","PID5")="5^00108^Patient's Name"
+        S X("PID","PID6")="6^00109^Mother's Maiden Name"
+        S X("PID","PID7")="7^00110^Date of Birth"
+        S X("PID","PID8")="8^00111^Sex"
+        S X("PID","PID9")="9^00112^Patient Alias"
+        S X("PID","PID10")="10^00113^Race"
+        S X("PID","PID11")="11^00114^Patient Address"
+        S X("PID","PID12")="12^00115^County Code"
+        S X("PID","PID13")="13^00116^Phone Number - Home"
+        S X("PID","PID14")="14^00117^Phone Number - Business"
+        S X("PID","PID15")="15^00118^Language - Patient"
+        S X("PID","PID16")="16^00119^Marital Status"
+        S X("PID","PID17")="17^00120^Religion"
+        S X("PID","PID18")="18^00121^Patient Account Number"
+        S X("PID","PID19")="19^00122^SSN Number - Patient"
+        S X("PID","PID20")="20^00123^Drivers License - Patient"
+        S X("PID","PID21")="21^00124^Mother's Identifier"
+        S X("PID","PID22")="22^00125^Ethnic Group"
+        S X("PID","PID23")="23^00126^Birth Place"
+        S X("PID","PID24")="24^00127^Multiple Birth Indicator"
+        S X("PID","PID25")="25^00128^Birth Order"
+        S X("PID","PID26")="26^00129^Citizenship"
+        S X("PID","PID27")="27^00130^Veteran.s Military Status"
+        S X("PID","PID28")="28^00739^Nationality"
+        S X("PID","PID29")="29^00740^Patient Death Date/Time"
+        S X("PID","PID30")="30^00741^Patient Death Indicator"
+        S X("NTE","NTE1")="1^00573^Set ID - NTE"
+        S X("NTE","NTE2")="2^00574^Source of Comment"
+        S X("NTE","NTE3")="3^00575^Comment"
+        S X("ORC","ORC1")="1^00215^Order Control"
+        S X("ORC","ORC2")="2^00216^Placer Order Number"
+        S X("ORC","ORC3")="3^00217^Filler Order Number"
+        S X("ORC","ORC4")="4^00218^Placer Order Number"
+        S X("ORC","ORC5")="5^00219^Order Status"
+        S X("ORC","ORC6")="6^00220^Response Flag"
+        S X("ORC","ORC7")="7^00221^Quantity/Timing"
+        S X("ORC","ORC8")="8^00222^Parent"
+        S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
+        S X("ORC","ORC10")="10^00224^Entered By"
+        S X("ORC","ORC11")="11^00225^Verified By"
+        S X("ORC","ORC12")="12^00226^Ordering Provider"
+        S X("ORC","ORC13")="13^00227^Enterer's Location"
+        S X("ORC","ORC14")="14^00228^Call Back Phone Number"
+        S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
+        S X("ORC","ORC16")="16^00230^Order Control Code Reason"
+        S X("ORC","ORC17")="17^00231^Entering Organization"
+        S X("ORC","ORC18")="18^00232^Entering Device"
+        S X("ORC","ORC19")="19^00233^Action By"
+        S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
+        S X("OBR","OBR2")="2^00216^Placer Order Number"
+        S X("OBR","OBR3")="3^00217^Filler Order Number"
+        S X("OBR","OBR4")="4^00238^Universal Service ID"
+        S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
+        S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
+        S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
+        S X("OBR","OBR5")="5^00239^Priority"
+        S X("OBR","OBR6")="6^00240^Requested Date/Time"
+        S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
+        S X("OBR","OBR8")="8^00242^Observation End Date/Time"
+        S X("OBR","OBR9")="9^00243^Collection Volume"
+        S X("OBR","OBR10")="10^00244^Collector Identifier"
+        S X("OBR","OBR11")="11^00245^Specimen Action Code"
+        S X("OBR","OBR12")="12^00246^Danger Code"
+        S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
+        S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
+        S X("OBR","OBR15")="15^00249^Specimen Source"
+        S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
+        S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
+        S X("OBR","OBR18")="18^00251^Placers Field 1"
+        S X("OBR","OBR19")="19^00252^Placers Field 2"
+        S X("OBR","OBR20")="20^00253^Filler Field 1"
+        S X("OBR","OBR21")="21^00254^Filler Field 2"
+        S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
+        S X("OBR","OBR23")="23^00256^Charge to Practice"
+        S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
+        S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
+        S X("OBR","OBR26")="26^00259^Parent Result"
+        S X("OBR","OBR27")="27^00221^Quantity/Timing"
+        S X("OBR","OBR28")="28^00260^Result Copies to"
+        S X("OBR","OBR29")="29^00261^Parent Number"
+        S X("OBR","OBR30")="30^00262^Transportation Mode"
+        S X("OBR","OBR31")="31^00263^Reason for Study"
+        S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
+        S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
+        S X("OBR","OBR34")="34^00266^Technician"
+        S X("OBR","OBR35")="35^00267^Transcriptionist"
+        S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
+        S X("OBR","OBR37")="37^01028^Number of Sample Containers"
+        S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
+        S X("OBR","OBR39")="39^01030^Collector.s Comment"
+        S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
+        S X("OBR","OBR41")="41^01032^Transport Arranged"
+        S X("OBR","OBR42")="42^01033^Escort Required"
+        S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
+        S X("OBX","OBX1")="1^00559^Set ID - OBX"
+        S X("OBX","OBX2")="2^00676^Value Type"
+        S X("OBX","OBX3")="3^00560^Observation Identifier"
+        S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
+        S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
+        S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
+        S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
+        S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
+        S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
+        S X("OBX","OBX4")="4^00769^Observation Sub-Id"
+        S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
+        S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
+        S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
+        S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
+        S X("OBX","OBX9")="9^00639^Probability"
+        S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
+        S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
+        S X("OBX","OBX12")="12^00567^Date Last Normal Value"
+        S X("OBX","OBX13")="13^00581^User Defined Access Checks"
+        S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
+        S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
+        S X("OBX","OBX16")="16^00584^Responsible Observer"
+        S X("OBX","OBX17")="17^00936^Observation Method"
+        K ^TMP("C0CCCR","LABTBL")
+        M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
+        S ^TMP("C0CCCR","LABTBL",0)="V3"
+        Q

ccr/trunk/p/C0CPARMS.m

@@ -1 +1 @@
 C0CPARMS        ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 ; 6/15/12 3:46pm
-        ;;1.2;C0C;;May 11, 2012;Build 49
-        ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 WorldVistA.  
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
 SET(INPARMS)    ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS

ccr/trunk/p/C0CPROBS.m

@@ -1 +1 @@
 C0CPROBS        ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ; PROCESS THE PROBLEMS SECTION OF THE CCR
@@ -92 +88 @@
         ; GENERATE THE NARITIVE HTML FOR THE CCD
         I CCD D CCD ; IF THIS IS FOR A CCD
-        D MISSINGVARS
+        D MISSVARS
         Q
         ;
@@ -149 +145 @@
         ; GENERATE THE NARITIVE HTML FOR THE CCD
         I CCD D CCD ; IF THIS IS FOR A CCD
-        D MISSINGVARS
+        D MISSVARS
         Q
-CCD     
+CCD     ;
         N HTMP,HOUT,HTMLO,C0CPROBI,ZX
         F C0CPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
@@ -175 +171 @@
         D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
         Q
-MISSINGVARS     
+MISSVARS        ; Missing Variables
         N PROBSTMP,I
         D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS

ccr/trunk/p/C0CPROC.m

@@ -1 +1 @@
 C0CPROC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2010 George Lilly, University of Minnesota and others.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -112 +108 @@
         ; CPT^CATEGORY^TEXT
         N Z1,Z2,Z3,ZRTN
-        S Z1=$P(ISTR,U,1) 
+        S Z1=$P(ISTR,U,1)
         I Z1="" D  ;
         . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)

ccr/trunk/p/C0CPXRM.m

@@ -1 +1 @@
 C0CPXRM ; 
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
 DOIT    ;
-        S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
-        S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
-        S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
-        Q
+        ; S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
+        ; S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
+        ; S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
+        ; Q
         ;

ccr/trunk/p/C0CQRY1.m

@@ -1 +1 @@
 LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
-               ;;1.2;C0C;;May 11, 2012;Build 47
+               ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
                ;
                Q

ccr/trunk/p/C0CQRY2.m

@@ -1 @@
-LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
+LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 ; 10/30/12 10:16am
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ; JMC - mods to check for IHS V LAB file
+        ;
+        ; (C) John McCormack 2009
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         ;
         Q

ccr/trunk/p/C0CRAHL7.m

@@ -1 +1 @@
 C0CRAHL7        ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010
-               ;;1.2;C0C;;May 11, 2012;Build 47
-               ;;
-               Q
-               ;LENGTH OF SEGMENTS COMPROMISED
-GHL7       ; Loop through ^RADPT with RADFN
-               ; Get Case Number and Reprot Information
-               ; Extract RAD Report as HL7 Message
-               ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
-               ;
-               D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
-               D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
-               S C0CCNT=0
-               F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
-               . S C0CRAIDT=0
-               . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
-               . . S C0CRANO=0
-               . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
-               . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
-               . . . Q:C0CRAXAM(0)=""
-               . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
-               . . . Q:RARPT=""!(RARPT=0)
-               . . . ;Quit if no report information present
-               . . . D SETHL7
-               . . . S C0CSBCNT=0
-               . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
-               . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
-               . . . . S C0CCNT=C0CCNT+1
-               ;
-               K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
-               K C0CRAXAM,C0CCNT,C0CRAEDT
-               Q
-               ;
-SETHL7   ;SETHL7 SEGMENTS
-               N RASET,RACN0
-               S RASET=0
-               S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
-               I +$P(RACN0,U,25)=2 D  Q  ; printset
-               . ; loop through all cases in set and create message
-               . S RASET=1
-               . N RACNI,RAII S RAII=0
-               . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
-               . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
-               . . S RACNI=RAII
-               . . D NEW
-NEW         ; new variables
-               ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
-               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
-               N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
-               S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
-               S (HLECH,HL("ECH"))="^~\&"
-               S (HLFS,HL("FS"))="|"
-               S (HLQ,HL("Q"))=""""
-               S DFN=RADFN D DEM^VADPT
-               I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
-               S RAN=0
-               S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
-               D SETUP,PID,OBR,OBXRPT
-EXIT       ;EXIT FROM NEW
-               K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
-               Q
-               ;
-OBR         ;Compile 'OBR' Segment
-                       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"
-               S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
-               ; Replace above with following when Imaging can cope with ESC chars
-               ; 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"
-               ; Have to use LOCAL code if Broad Procedure - no CPT code
-               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 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 RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
-               S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
-               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")
-               ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
-               N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
-               S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),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)),"^")
-               S $P(X1,HLFS,21)=$P(X1,HLFS,21)
-               ; Replace above with following when Imaging can cope with ESC chars
-               ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
-               ;
-               S OBR36=9999999.9999-RADTI
-               S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
-               ;
-               S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
-               S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
-               ;Principal Result Interpreter = Verifying Physician
-               S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
-               .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
-               .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
-               .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
-               ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
-               S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
-               .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
-               .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
-               .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
-               I $P(RACN0,"^",12) D
-               .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
-               .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
-               .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
-               ;Technician = Technologist
-               S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
-               .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
-               .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
-               .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
-               .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
-               .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
-               ;Transcriptionist
-               S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
-               .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
-               .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
-               .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
-               ;
-               S RAN=RAN+1
-               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 HLA("HLS",RAN)=X1
-               Q
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; (C) ELN 2010.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
+        ;
+        Q
+        ;LENGTH OF SEGMENTS COMPROMISED
+GHL7    ; Loop through ^RADPT with RADFN
+        ; Get Case Number and Reprot Information
+        ; Extract RAD Report as HL7 Message
+        ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
+        ;
+        D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
+        D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+        S C0CCNT=0
+        F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
+        . S C0CRAIDT=0
+        . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
+        . . S C0CRANO=0
+        . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
+        . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
+        . . . Q:C0CRAXAM(0)=""
+        . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
+        . . . Q:RARPT=""!(RARPT=0)
+        . . . ;Quit if no report information present
+        . . . D SETHL7
+        . . . S C0CSBCNT=0
+        . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
+        . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
+        . . . . S C0CCNT=C0CCNT+1
+        ;
+        K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
+        K C0CRAXAM,C0CCNT,C0CRAEDT
+        Q
+        ;
+SETHL7  ;SETHL7 SEGMENTS
+        N RASET,RACN0
+        S RASET=0
+        S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+        I +$P(RACN0,U,25)=2 D  Q  ; printset
+        . ; loop through all cases in set and create message
+        . S RASET=1
+        . N RACNI,RAII S RAII=0
+        . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
+        . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
+        . . S RACNI=RAII
+        . . D NEW
+NEW     ; new variables
+        ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
+        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
+        N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
+        S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
+        S (HLECH,HL("ECH"))="^~\&"
+        S (HLFS,HL("FS"))="|"
+        S (HLQ,HL("Q"))=""""
+        S DFN=RADFN D DEM^VADPT
+        I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
+        S RAN=0
+        S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
+        D SETUP,PID,OBR,OBXRPT
+EXIT    ;EXIT FROM NEW
+        K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
+        Q
+        ;
+OBR     ;Compile 'OBR' Segment
+        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"
+        S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
+        ; Replace above with following when Imaging can cope with ESC chars
+        ; 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"
+        ; Have to use LOCAL code if Broad Procedure - no CPT code
+        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 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 RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
+        S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
+        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")
+        ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
+        N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
+        S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),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)),"^")
+        S $P(X1,HLFS,21)=$P(X1,HLFS,21)
+        ; Replace above with following when Imaging can cope with ESC chars
+        ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
+        ;
+        S OBR36=9999999.9999-RADTI
+        S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
+        ;
+        S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
+        S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
+        ;Principal Result Interpreter = Verifying Physician
+        S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
+        .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
+        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
+        .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
+        ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
+        S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
+        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
+        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
+        .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
+        I $P(RACN0,"^",12) D
+        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
+        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
+        .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
+        ;Technician = Technologist
+        S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
+        .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
+        .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
+        .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
+        .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
+        .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
+        ;Transcriptionist
+        S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
+        .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
+        .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
+        .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
+        ;
+        S RAN=RAN+1
+        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 HLA("HLS",RAN)=X1
+        Q
 OBXRPT   ;Compile 'OBX' Segment for Radiology Report Text
-               N RATX
-               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 RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
-               S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
-               Q
-PID         ;Compile 'PID' Segment
-               ;
-               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 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
-               Q
-SETUP     ; Setup basic examination information
-               S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
-               S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,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 RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
-               S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
-               S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
-               Q
+        N RATX
+        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 RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
+        S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
+        Q
+PID     ;Compile 'PID' Segment
+        ;
+        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 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
+        Q
+SETUP   ; Setup basic examination information
+        S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+        S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,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 RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
+        S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
+        S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
+        Q

ccr/trunk/p/C0CRARPT.m

@@ -1 @@
-C0CRARPT               ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
-               ;;1.2;C0C;;May 11, 2012;Build 47
-MAP(MIXML,DFN,MOXML)       ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
-               ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
-               ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
-               ; MIXML IS THE TEMPLATE TO USE
-               ; MOXML IS THE OUTPUT XML ARRAY
-               ; DFN IS THE PATIENT RECORD NUMBER
-               N C0COXML,C0CO,C0CV,C0CIXML
-               I '$D(MIVAR) S C0CV="" ;DEFAULT
-               E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
-               I '$D(MIXML) S C0CIXML="" ;DEFAULT
-               E  S C0CIXML=MIXML ;PASSED INPUT XML
-               D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
-               I '$D(MOXML) D  Q
-               . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
-               . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
-               E  D
-               . N C0COOXML
-               . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
-               . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
-               . S C0COCNT=$O(C0CRSXML(""),-1)
-               . S C0CRES=0
-               . F  S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES=""  D
-               . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
-               . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
-               . . S C0COCNT=C0COCNT+1
-               . S C0CRSXML(C0COCNT)="</Results>"
-               . S C0CRSXML(0)=C0COCNT
-               . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-               . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
-               S C0CO=MOXML,@C0CO@(0)=0
-               K C0CRSXML,C0COCNT,C0COXML,C0CRES
-               Q
-RPCMAP(RTN,DFN,RMIVAR,RMIXML)     ; RPC ENTRY POINT FOR MAPPING RESULTS
-               ; RTN IS PASSED BY REFERENCE
-               N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
-               N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
-               I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
-               I RMIXML="" D  ; INPUT XML NOT PASSED
-               . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
-               . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
-               . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
-               E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
-               I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
-               . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
-               E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
-               D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
-               D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
-               D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
-               D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
-               I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
-               . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
-               ; NO RESULTS
-               I @C0CV@(0)=0 S RTN(0)=0 Q
-               S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
-               K @RIMVARS
-               M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
-               N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
-               S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
-               N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
-               N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
-               N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
-               ; TO IMPROVE PERFORMANCE
-               D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
-               F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
-               . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
-               . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
-               . S C0CMAP=$NA(@C0CV@(C0CI)) ;
-               . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
-               . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
-               . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
-               . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
-               . . K C0CTO ; CLEAR OUTPUT VARIABLE
-               . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
-               . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
-               . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
-               . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
-               . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
-               . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
-               . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
-               . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
-               . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
-               . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
-               D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
-               D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
-               K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
-               Q
-EXTRACT(ILXML,DFN,OLXML)               ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
-               S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
-               S RADFN=DFN
-               D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
-               ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
-               N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
-               S C0CQT=1 ; SURPRESS LISTING
-               D LIST ; EXTRACT THE VARIABLES
-               ;S C0CQT=QTSAV ; RESET SILENT FLAG
-               K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
-               K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
-               I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
-               Q
-LIST       ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
-               N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
-               I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-               I '$D(C0CQT) S C0CQT=0
-               I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
-               I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
-               . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
-               . K ^TMP("C0CCCR","RATBL")
-               . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
-               I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
-               S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
-               S C0CHB=$NA(^TMP("HLS",$J))
-               S C0CI=""
-               S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
-               F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
-               . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
-               . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
-               . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
-               . M XV=C0CVAR ;
-               . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
-               . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
-               . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
-               . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
-               . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
-               . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
-               . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
-               . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
-               . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-               . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-               . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
-               . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
-               . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
-               . . ; RESULTTESTCODEVALUE
-               . . ; RESULTTESTDESCRIPTIONTEXT
-               . . I C0CVAR("C3")="C4" D  ; PRIMARY CODE "CPT"
-               . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
-               . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
-               . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
-               . . E  I C0CVAR("C6")'="" D  ; NO CPT CODES, USE SECONDARY IF PRESENT
-               . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
-               . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
-               . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
-               . . E  D  ; NO SECONDARY, USE PRIMARY
-               . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
-               . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
-               . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
-               . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
-               . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
-               . . S C0CZG=XV("RESULTTESTVALUE")
-               . . S XV("RESULTTESTVALUE")=C0CZG
-               . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
-               . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
-               . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
-               . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
-               . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
-               . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
-               . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
-               . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
-               . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
-               . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
-               . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-               . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-               . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
-               K XV,C0CZG,C0CX1,C0CX2,C0CVAR
-               Q
+C0CRARPT        ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; (C) ELN 2010
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
+MAP(MIXML,DFN,MOXML)      ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
+        ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
+        ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
+        ; MIXML IS THE TEMPLATE TO USE
+        ; MOXML IS THE OUTPUT XML ARRAY
+        ; DFN IS THE PATIENT RECORD NUMBER
+        N C0COXML,C0CO,C0CV,C0CIXML
+        I '$D(MIVAR) S C0CV="" ;DEFAULT
+        E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
+        I '$D(MIXML) S C0CIXML="" ;DEFAULT
+        E  S C0CIXML=MIXML ;PASSED INPUT XML
+        D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
+        I '$D(MOXML) D  Q
+        . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
+        . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
+        E  D
+        . N C0COOXML
+        . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
+        . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
+        . S C0COCNT=$O(C0CRSXML(""),-1)
+        . S C0CRES=0
+        . F  S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES=""  D
+        . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
+        . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
+        . . S C0COCNT=C0COCNT+1
+        . S C0CRSXML(C0COCNT)="</Results>"
+        . S C0CRSXML(0)=C0COCNT
+        . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+        . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
+        S C0CO=MOXML,@C0CO@(0)=0
+        K C0CRSXML,C0COCNT,C0COXML,C0CRES
+        Q
+RPCMAP(RTN,DFN,RMIVAR,RMIXML)   ; RPC ENTRY POINT FOR MAPPING RESULTS
+        ; RTN IS PASSED BY REFERENCE
+        N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
+        N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
+        I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
+        I RMIXML="" D  ; INPUT XML NOT PASSED
+        . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
+        . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
+        . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
+        E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
+        I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
+        . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
+        E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
+        D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
+        D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
+        D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
+        D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
+        I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
+        . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
+        ; NO RESULTS
+        I @C0CV@(0)=0 S RTN(0)=0 Q
+        S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
+        K @RIMVARS
+        M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
+        N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
+        S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
+        N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
+        N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
+        N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
+        ; TO IMPROVE PERFORMANCE
+        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
+        F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
+        . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
+        . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
+        . S C0CMAP=$NA(@C0CV@(C0CI)) ;
+        . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
+        . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
+        . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
+        . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
+        . . K C0CTO ; CLEAR OUTPUT VARIABLE
+        . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
+        . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
+        . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
+        . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
+        . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
+        . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
+        . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
+        . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
+        . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
+        . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
+        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
+        D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
+        K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+        Q
+EXTRACT(ILXML,DFN,OLXML)        ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
+        S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
+        S RADFN=DFN
+        D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
+        ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+        N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
+        S C0CQT=1 ; SURPRESS LISTING
+        D LIST ; EXTRACT THE VARIABLES
+        ;S C0CQT=QTSAV ; RESET SILENT FLAG
+        K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
+        K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
+        I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+        Q
+LIST    ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
+        N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
+        I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+        I '$D(C0CQT) S C0CQT=0
+        I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
+        I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
+        . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
+        . K ^TMP("C0CCCR","RATBL")
+        . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
+        I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
+        S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
+        S C0CHB=$NA(^TMP("HLS",$J))
+        S C0CI=""
+        S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
+        F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
+        . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
+        . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
+        . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
+        . M XV=C0CVAR ;
+        . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
+        . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
+        . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
+        . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
+        . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
+        . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
+        . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
+        . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
+        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+        . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+        . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
+        . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
+        . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
+        . . ; RESULTTESTCODEVALUE
+        . . ; RESULTTESTDESCRIPTIONTEXT
+        . . I C0CVAR("C3")="C4" D  ; PRIMARY CODE "CPT"
+        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
+        . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
+        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
+        . . E  I C0CVAR("C6")'="" D  ; NO CPT CODES, USE SECONDARY IF PRESENT
+        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
+        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
+        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
+        . . E  D  ; NO SECONDARY, USE PRIMARY
+        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
+        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
+        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
+        . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
+        . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
+        . . S C0CZG=XV("RESULTTESTVALUE")
+        . . S XV("RESULTTESTVALUE")=C0CZG
+        . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+        . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+        . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+        . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+        . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+        . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
+        . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
+        . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
+        . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+        . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
+        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+        . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+        . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+        K XV,C0CZG,C0CX1,C0CX2,C0CVAR
+        Q

ccr/trunk/p/C0CRIMA.m

@@ -1 +1 @@
 C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
@@ -100 +97 @@
            . W "CATEGORY NAME: ",CATNAME,!
            . ;
-           . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
+           . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN)  ; NEXT PATIENT
            . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
            . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
@@ -386 +383 @@
            I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
            S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-           I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
+           I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q  ; NO VARIABLES IN SECTION
            . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
            N ZZI,ZZS
@@ -420 +417 @@
            N ZNC  ; ZNC IS NUMBER OF CATEGORIES
            S ZNC=@ZCBASE@(0)
-           I ZNC=0 Q ; NO CATEGORIES TO SEARCH
+           I ZNC=0 Q  ; NO CATEGORIES TO SEARCH
            N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
            S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)

ccr/trunk/p/C0CRNF.m

@@ -1 +1 @@
 C0CRNF    ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is the Reference Name Format (RNF) Utility Library ",!
@@ -29 +27 @@
         S C0CFI=0 S C0CFJ=C0CF
         K @C0CFRTN ; CLEAR THE RETURN ARRAY
-        F  Q:C0CFJ'[C0CF  D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
+        F  Q:C0CFJ'[C0CF  D  ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
         . ;W "1: "_C0CFJ," ",C0CFI,!
         . F  S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0  D  ; EVERY FIELD
@@ -53 +51 @@
         S G1("THREE")=3
         D RNF1TO2("GPL","G1")
-        ZWR GPL
+        ; ZWR GPL
         Q
         ;

ccr/trunk/p/C0CRNFRP.m

@@ -1 +1 @@
 C0CRNFRP        ; CCDCCR/GPL - Reference Name Format (RNF) RPCs; 12/9/09 ; 5/10/12 2:56pm
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is the Reference Name Format (RNF) RPC Library ",!

ccr/trunk/p/C0CRPMS.m

@@ -1 +1 @@
 C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09  14:33
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -27 +24 @@
 VTYPES  ;
         D GETN2^C0CRNF("G1",9999999.07)
-        ZWR G1
+        ; ZWR G1
         Q
         ;
@@ -92 +89 @@
         . W "PAT: ",C0CG,!
         . D GETNV^C0CRPMS(C0CG)
-        . K X R X
+        . K X R X:DTIME
         . I X="Q" S C0CQ=1 ; QUIT IF Q
         Q

ccr/trunk/p/C0CRXN.m

@@ -1 +1 @@
 C0CRXN    ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is the CCR RXNORM Utility Library ",!
@@ -53 +51 @@
         . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
         . E  D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
-        . . ;ZWR C0CA
+        . ;ZWR C0CA
         . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
         . I $$ZVALUE("RXCUI","C0CB")'="" D  ; RXNORM FOUND
@@ -74 +72 @@
         . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
         . D UPDATE^DIE("","C0CFDA")
-        . I $D(^TMP("DIERR",$J)) U $P BREAK
+        . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
         W "HAS RXN=",HASRXN,!
         W "NO RXN=",NORXN,!
@@ -150 +148 @@
         . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
         . D UPDATE^DIE("","C0CFDA")
-        . I $D(^TMP("DIERR",$J)) U $P BREAK
+        . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
         W "VA MAPPING VUID COUNT: ",VAVCNT,!
         W "VA MAPPING MISSING: ",VANO,!
@@ -216 +214 @@
         Q
         ;
+        D
         . I $$ZVALUE("MEDIATION CODE")="" D
         . . S NORXN=NORXN+1 ;
@@ -225 +224 @@
         . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
         . E  D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
-        . . ;ZWR C0CA
+        . ;ZWR C0CA
         . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
         . I $$ZVALUE("RXCUI","C0CB")'="" D  ; RXNORM FOUND
@@ -245 +244 @@
         . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
         . D UPDATE^DIE("","C0CFDA")
-        . I $D(^TMP("DIERR",$J)) U $P BREAK
+        . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
         W "HAS RXN=",HASRXN,!
         W "NO RXN=",NORXN,!

ccr/trunk/p/C0CRXNRD.m

@@ -1 +1 @@
 C0CRXNRD        ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; Copyright Sam Habiel 2008.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         W "No entry from top" Q
-IMPORT(PATH)    
+IMPORT(PATH)    ; Main entry point
         I PATH="" QUIT
         D READSRC(PATH),READCON(PATH),READNDC(PATH)
@@ -21 +36 @@
         U IO
         N I
-        F I=1:1 R LINE Q:$$STATUS^%ZISH
+        F I=1:1 R LINE:0 Q:$$STATUS^%ZISH
         D CLOSE^%ZISH("FILE")
         Q I-1
@@ -37 +52 @@
         F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
         . U IO
-        . N LINE R LINE
+        . N LINE R LINE:0
         . IF $$STATUS^%ZISH QUIT
         . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
@@ -82 +97 @@
         F C0CCOUNT=1:1 Q:$$STATUS^%ZISH  D
         . U IO
-        . N LINE R LINE
+        . N LINE R LINE:0
         . IF $$STATUS^%ZISH QUIT
         . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
@@ -106 +121 @@
         F I=1:1 Q:$$STATUS^%ZISH  D
         . U IO
-        . N LINE R LINE
+        . N LINE R LINE:0
         . IF $$STATUS^%ZISH QUIT
         . U $P W I,! U IO  ; Write I to the screen, then go back to reading the file
@@ -141 +156 @@
 EX3     D CLOSE^%ZISH("FILE")
         Q
-        

ccr/trunk/p/C0CSNOA.m

@@ -1 +1 @@
 C0CSNOA   ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-        ;
-        ; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES
-        ; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD
-        ; USING THE VISTA LEXICON ^LEX
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
 ANALYZE(BEGIEN,IENCNT)  ; SNOMED RETRIEVAL ANALYSIS ROUTINE
-           ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
-           ; TO RESUME AT NEXT DRUG, USE BEGIEN=""
-           ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
-           ;
-           N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
-           N CCRGLO
-           D ASETUP ; SET UP VARIABLES AND GLOBALS
-           D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
-           I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
-           S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
-           S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
-           I SNOIEN="" S SNOIEN=RESUME
-           I +SNOIEN=0 D  Q  ; AT THE END OF THE ALLERGY LIST
-           . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
-           F SNOI=1:1:IENCNT  D  Q:+SNOIEN=0  ; FOR IENCNT NUMBER OF PATIENTS OR END
-           . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
-           . W SNOIEN,@GMRBASE@(SNOIEN,0),!
-           . N SNORTN,TTERM ; RETURN ARRAY
-           . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
-           . D TEXTRPC(.SNORTN,TTERM)
-           . I $D(SNORTN) ZWR SNORTN
-           . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
-           . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
-           . ;
-           . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-           . ;
-           . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-           . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
-           . ;
-           . N CATNAME,CATTBL
-           . S CATNAME=""
-           . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
-           . ; W "CATEGORY NAME: ",CATNAME,!
-           . ;
-           . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
-           . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
-           ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
-           Q
-           ;
+        ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
+        ; TO RESUME AT NEXT DRUG, USE BEGIEN=""
+        ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
+        ;
+        N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
+        N CCRGLO
+        D ASETUP ; SET UP VARIABLES AND GLOBALS
+        D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+        I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
+        S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+        S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
+        I SNOIEN="" S SNOIEN=RESUME
+        I +SNOIEN=0 D  Q  ; AT THE END OF THE ALLERGY LIST
+        . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
+        F SNOI=1:1:IENCNT  D  Q:+SNOIEN=0  ; FOR IENCNT NUMBER OF PATIENTS OR END
+        . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
+        . W SNOIEN,@GMRBASE@(SNOIEN,0),!
+        . N SNORTN,TTERM ; RETURN ARRAY
+        . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
+        . D TEXTRPC(.SNORTN,TTERM)
+        . ; I $D(SNORTN) ZWR SNORTN
+        . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
+        . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
+        . ;
+        . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+        . ;
+        . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+        . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
+        . ;
+        . N CATNAME,CATTBL
+        . S CATNAME=""
+        . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
+        . ; W "CATEGORY NAME: ",CATNAME,!
+        . ;
+        . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
+        . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
+        ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
+        Q
+        ;
 TEXTRPC(ORTN,ITEXT)     ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
         ;
@@ -71 +64 @@
         ;
 ASETUP  ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
-             I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
-             I '$D(@SNOBASE) S @SNOBASE=""
-             I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
-             I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
-             S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
-             Q
-             ;
+        I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
+        I '$D(@SNOBASE) S @SNOBASE=""
+        I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
+        I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
+        S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
+        Q
+        ;
 AINIT   ; INITIALIZE ATTRIBUTE TABLE
-             I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
-             K @SNOTBL
-             D APUSH^C0CRIMA(SNOTBL,"CODE")
-             D APUSH^C0CRIMA(SNOTBL,"NOCODE")
-             D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
-             D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
-             D APUSH^C0CRIMA(SNOTBL,"DONE")
-             Q
+        I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
+        K @SNOTBL
+        D APUSH^C0CRIMA(SNOTBL,"CODE")
+        D APUSH^C0CRIMA(SNOTBL,"NOCODE")
+        D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
+        D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
+        D APUSH^C0CRIMA(SNOTBL,"DONE")
+        Q
 APOST(PRSLT,PTBL,PVAL)  ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-           ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-           ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
-           ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-           I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-           N USETBL
-           I '$D(@SNOBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-           . W "ERROR NO SUCH TABLE",!
-           S USETBL=@SNOBASE@("TABLES",PTBL)
-           S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-           Q
+        ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+        ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
+        ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+        I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+        N USETBL
+        I '$D(@SNOBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+        . W "ERROR NO SUCH TABLE",!
+        S USETBL=@SNOBASE@("TABLES",PTBL)
+        S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+        Q
 SETATTR(SDFN)   ; SET ATTRIBUTES BASED ON VARS
-           N SBASE,SATTR
-           S SBASE=$NA(@SNOBASE@("VARS",SDFN))
-           D APOST("SATTR","SNOTBL","DONE")
-           I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
-           I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
-           Q SATTR  ; C0C
-           I $D(@SBASE@("PROBLEMS",1)) D  ;
-           . D APOST("SATTR","SNOTBL","PROBLEMS")
-           . ; W "POSTING PROBLEMS",!
-           I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
-           I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-           . D APOST("SATTR","SNOTBL","MEDS")
-           . N ZR,ZI
-           . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-           . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-           . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-           . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
-           . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-           D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-           ; W "ATTRIBUTES: ",SATTR,!
-           Q SATTR
-           ;
+        N SBASE,SATTR
+        S SBASE=$NA(@SNOBASE@("VARS",SDFN))
+        D APOST("SATTR","SNOTBL","DONE")
+        I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
+        I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
+        Q SATTR  ; C0C
+        I $D(@SBASE@("PROBLEMS",1)) D  ;
+        . D APOST("SATTR","SNOTBL","PROBLEMS")
+        . ; W "POSTING PROBLEMS",!
+        I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
+        I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
+        . D APOST("SATTR","SNOTBL","MEDS")
+        . N ZR,ZI
+        . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
+        . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+        . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+        . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
+        . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
+        D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+        ; W "ATTRIBUTES: ",SATTR,!
+        Q SATTR
+        ;
 RESET   ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
-           K ^TMP("C0CSNO","RESUME")
-           K ^TMP("C0CSNO")
-           Q
-           ;
+        K ^TMP("C0CSNO","RESUME")
+        K ^TMP("C0CSNO")
+        Q
+        ;
 CLIST   ; LIST THE CATEGORIES
-           ;
-           I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
-           N CLBASE,CLNUM,ZI,CLIDX
-           S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
-           S CLNUM=@CLBASE@(0)
-           F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-           . S CLIDX=@CLBASE@(ZI)
-           . W "(",$P(@CLBASE@(CLIDX),"^",1)
-           . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-           . W CLIDX,!
-           ; D PARY^C0CXPATH(CLBASE)
-           Q
-           ;
+        ;
+        I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
+        N CLBASE,CLNUM,ZI,CLIDX
+        S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
+        S CLNUM=@CLBASE@(0)
+        F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+        . S CLIDX=@CLBASE@(ZI)
+        . W "(",$P(@CLBASE@(CLIDX),"^",1)
+        . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+        . W CLIDX,!
+        ; D PARY^C0CXPATH(CLBASE)
+        Q
+        ;
 CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR)     ; ADD PATIENTS TO CATEGORIES
-           ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-           ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-           ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-           ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-           ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-           ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-           ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-           ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-           ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-           ; NUMBER IE CTBL_X(CDFN)=""
-           ;
-           ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-           S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-           ; W "CBASE: ",CCTBL,!
-           ;
-           I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-           . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-           . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-           . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-           . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-           . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-           . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-           ;
-           S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-           S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-           S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-           ;
-           S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-           ;
-           S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-           ; W "IENS BASE: ",CPATLIST,!
-           S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-           ;
-           Q
-           ;
+        ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+        ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+        ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+        ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+        ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+        ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+        ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+        ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+        ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+        ; NUMBER IE CTBL_X(CDFN)=""
+        ;
+        ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+        S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+        ; W "CBASE: ",CCTBL,!
+        ;
+        I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+        . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+        . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+        . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+        . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+        . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+        . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+        ;
+        S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+        S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+        S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+        ;
+        S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+        ;
+        S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+        ; W "IENS BASE: ",CPATLIST,!
+        S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+        ;
+        Q
+        ;
 REUSE   ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
         ;
@@ -183 +176 @@
         S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
         S SNOI=""
-        F  D  Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
+        F  D  Q:$O(@SAVBASE@(SNOI))=""  ;THE WHOLE LIST
         . S SNOI=$O(@SAVBASE@(SNOI))
         . S SNOJ=@SAVBASE@(SNOI)

ccr/trunk/p/C0CSOAP.m

@@ -1 +1 @@
 C0CSOAP  ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is an SOAP utility library",!

ccr/trunk/p/C0CSQMB.m

@@ -1 +1 @@
 C0CSQMB ; SQMCCR/ELN  - BATCH PROGRAM ;16/11/2010
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; (C) 2010 ELN
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
 EN      ;Traverse the DPT global and export CCR xml for each DFN

ccr/trunk/p/C0CSUB1.m

@@ -1 +1 @@
 C0CSUB1   ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is the CCR SUBSCRIPTIONN Utility Library ",!
@@ -29 +27 @@
         S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
         S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
-        K C0CFDA 
+        K C0CFDA
         S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
         I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
-        E  Q ; NO CHECKSUMS FOR THISPATIENT
+        E  Q  ; NO CHECKSUMS FOR THISPATIENT
         D UPDIE
         N C0CJ S C0CJ=""
         F  S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ=""  D  ; FOR EACH DOMAIN
-        . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,"")) 
+        . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
         . W C0CJ," ",C0CD,!
         . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
@@ -70 +68 @@
         D CLEAN^DILF
         D UPDATE^DIE("","C0CFDA","","ZERR")
-        I $D(ZERR) D  ;
-        . W "ERROR",!
-        . ZWR ZERR
-        . B
+        I $D(ZERR) S $EC=",U1,"
         K C0CFDA
         Q

ccr/trunk/p/C0CSYS.m

@@ -1 +1 @@
 C0CSYS  ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-        ; General Public License See attached copy of the License.
-        ; 
-        ; This program is free software; you can redistribute it and/or modify
-        ; it under the terms of the GNU General Public License as published by
-        ; the Free Software Foundation; either version 2 of the License, or
-        ; (at your option) any later version.
-        ; 
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; Copyright 2008 WorldVistA.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
         ; This program is distributed in the hope that it will be useful,
         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ; GNU General Public License for more details.
-        ; 
-        ; You should have received a copy of the GNU General Public License along
-        ; with this program; if not, write to the Free Software Foundation, Inc.,
-        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "Enter at appropriate points." Q

ccr/trunk/p/C0CTIU.m

@@ -1 +1 @@
 C0CTIU  ; C0C/ELN - PROCESSING FOR TIU NOTES ; 19/10/2010
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ; (C) ELN 2010
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         ;ELN - Modified Routine of C0CLABS

ccr/trunk/p/C0CTIU1.m

@@ -1 +1 @@
 C0CTIU1 ; C0C/ELN - PROCESSING FOR TIU NOTES Contd. ; 19/10/2010
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;ELN UTILITY PROGRAM TO SUPPORT C0CTIU
+        ; (C) ELN 2010. 
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
 C0CDATE(EDTE)   ; Converts external date to internal date format
         ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)

ccr/trunk/p/C0CUNIT.m

@@ -1 +1 @@
 C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 George Lilly. Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 George Lilly. 
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
-                 W "This is a unit testing library",!
-                 W !
-                 Q
-                 ;
+        W "This is a unit testing library",!
+        W !
+        Q
+        ;
 ZT(ZARY,BAT,TST)        ; private routine to add a test case to the ZARY array
-                 ; ZARY IS PASSED BY REFERENCE
-                 ; BAT is a string identifying the test battery
-                 ; TST is a test which will evaluate to true or false
-                 ; I '$G(ZARY) D
-                 ; . S ZARY(0)=0 ; initially there are no elements
-                 ; W "GOT HERE LOADING "_TST,!
-                 N CNT ; count of array elements
-                 S CNT=ZARY(0) ; contains array count
-                 S CNT=CNT+1 ; increment count
-                 S ZARY(CNT)=TST ; put the test in the array
-                 I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
-                 . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
-                 . S II=$P(ZARY(BAT),"^",2)
-                 . S $P(ZARY(BAT),"^",2)=II+1
-                 I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
-                 . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
-                 . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
-                 . ; S TN=$NA(ZARY("TESTS"))
-                 . ; D PUSH^C0CXPATH(TN,BAT)
-                 S ZARY(0)=CNT ; update the array counter
-                 Q
-                 ;
+        ; ZARY IS PASSED BY REFERENCE
+        ; BAT is a string identifying the test battery
+        ; TST is a test which will evaluate to true or false
+        ; I '$G(ZARY) D
+        ; . S ZARY(0)=0 ; initially there are no elements
+        ; W "GOT HERE LOADING "_TST,!
+        N CNT ; count of array elements
+        S CNT=ZARY(0) ; contains array count
+        S CNT=CNT+1 ; increment count
+        S ZARY(CNT)=TST ; put the test in the array
+        I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
+        . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+        . S II=$P(ZARY(BAT),"^",2)
+        . S $P(ZARY(BAT),"^",2)=II+1
+        I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
+        . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+        . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+        . ; S TN=$NA(ZARY("TESTS"))
+        . ; D PUSH^C0CXPATH(TN,BAT)
+        S ZARY(0)=CNT ; update the array counter
+        Q
+        ;
 ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
-                 ; ZARY IS PASSED BY NAME
-                 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
-                 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
-                 K @ZARY
-                 S @ZARY@(0)=0 ; initialize array count
-                 N LINE,LABEL,BODY
-                 N INTEST S INTEST=0 ; switch for in the test case section
-                 N SECTION S SECTION="[anonymous]" ; test case section
-                 ;
-                 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
-                 . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
-                 . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
-                 . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
-                 . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
-                 . I INTEST  D  ; within the testing section
-                 . . I LINE?." "1";;><".E  D  ; section name found
-                 . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
-                 . . I LINE?." "1";;>>".E  D  ; test case found
-                 . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
-                 S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
-                 Q
-                 ;
+        ; ZARY IS PASSED BY NAME
+        ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+        ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+        K @ZARY
+        S @ZARY@(0)=0 ; initialize array count
+        N LINE,LABEL,BODY
+        N INTEST S INTEST=0 ; switch for in the test case section
+        N SECTION S SECTION="[anonymous]" ; test case section
+        ;
+        N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+        . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
+        . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+        . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+        . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
+        . I INTEST  D  ; within the testing section
+        . . I LINE?." "1";;><".E  D  ; section name found
+        . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+        . . I LINE?." "1";;>>".E  D  ; test case found
+        . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+        S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+        Q
+        ;
 ZTEST(ZARY,WHICH)         ; try out the tests using a passed array ZTEST
-                 N ZI,ZX,ZR,ZP
-                 S DEBUG=0
-                 ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
-                 ; . W "DOING ALL",!
-                 ; . N J,NT
-                 ; . S NT=$NA(ZARY("TESTS"))
-                 ; . W NT,@NT@(0),!
-                 ; . F J=1:1:@NT@(0) D  ;
-                 ; . . W @NT@(J),!
-                 ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
-                 I '$D(ZARY(WHICH))  D  Q ; TEST SECTION DOESN'T EXIST
-                 . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-                 N FIRST,LAST
-                 S FIRST=$P(ZARY(WHICH),"^",1)
-                 S LAST=$P(ZARY(WHICH),"^",2)
-                 F ZI=FIRST:1:LAST  D
-                 . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-                 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-                 . . ;  W ZP,!
-                 . . S ZX=ZP
-                 . . W "RUNNING: "_ZP
-                 . . X ZX
-                 . . W "..SUCCESS: ",WHICH,!
-                 . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-                 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-                 . . S ZX="S ZR="_ZP
-                 . . W "TRYING: "_ZP
-                 . . X ZX
-                 . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-                 . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-                 . . . S TPASSED=0 S TFAILED=0
-                 . . I ZR S TPASSED=TPASSED+1
-                 . . I 'ZR S TFAILED=TFAILED+1
-                 Q
-                 ;
+        N ZI,ZX,ZR,ZP
+        S DEBUG=0
+        ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+        ; . W "DOING ALL",!
+        ; . N J,NT
+        ; . S NT=$NA(ZARY("TESTS"))
+        ; . W NT,@NT@(0),!
+        ; . F J=1:1:@NT@(0) D  ;
+        ; . . W @NT@(J),!
+        ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
+        I '$D(ZARY(WHICH))  D  Q  ; TEST SECTION DOESN'T EXIST
+        . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+        N FIRST,LAST
+        S FIRST=$P(ZARY(WHICH),"^",1)
+        S LAST=$P(ZARY(WHICH),"^",2)
+        F ZI=FIRST:1:LAST  D
+        . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+        . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+        . . ;  W ZP,!
+        . . S ZX=ZP
+        . . W "RUNNING: "_ZP
+        . . X ZX
+        . . W "..SUCCESS: ",WHICH,!
+        . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+        . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+        . . S ZX="S ZR="_ZP
+        . . W "TRYING: "_ZP
+        . . X ZX
+        . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+        . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+        . . . S TPASSED=0 S TFAILED=0
+        . . I ZR S TPASSED=TPASSED+1
+        . . I 'ZR S TFAILED=TFAILED+1
+        Q
+        ;
 TEST      ; RUN ALL THE TEST CASES
-                 N ZTMP
-                 D ZLOAD(.ZTMP)
-                 D ZTEST(.ZTMP,"ALL")
-                 W "PASSED: ",TPASSED,!
-                 W "FAILED: ",TFAILED,!
-                 W !
-                 W "THE TESTS!",!
-                 ; I DEBUG ZWR ZTMP
-                 Q
-                 ;
+        N ZTMP
+        D ZLOAD(.ZTMP)
+        D ZTEST(.ZTMP,"ALL")
+        W "PASSED: ",TPASSED,!
+        W "FAILED: ",TFAILED,!
+        W !
+        W "THE TESTS!",!
+        ; I DEBUG ZWR ZTMP
+        Q
+        ;
 GTSTS(GTZARY,RTN)       ; return an array of test names
-                 N I,J S I="" S I=$O(GTZARY("TESTS",I))
-                 F J=0:0  Q:I=""  D
-                 . D PUSH^C0CXPATH(RTN,I)
-                 . S I=$O(GTZARY("TESTS",I))
-                 Q
-                 ;
+        N I,J S I="" S I=$O(GTZARY("TESTS",I))
+        F J=0:0  Q:I=""  D
+        . D PUSH^C0CXPATH(RTN,I)
+        . S I=$O(GTZARY("TESTS",I))
+        Q
+        ;
 TESTALL(RNM)    ; RUN ALL THE TESTS
-                 N ZI,J,TZTMP,TSTS,TOTP,TOTF
-                 S TOTP=0 S TOTF=0
-                 D ZLOAD^C0CUNIT("TZTMP",RNM)
-                 D GTSTS(.TZTMP,"TSTS")
-                 F ZI=1:1:TSTS(0) D  ;
-                 . S TPASSED=0 S TFAILED=0
-                 . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
-                 . S TOTP=TOTP+TPASSED
-                 . S TOTF=TOTF+TFAILED
-                 . S $P(TSTS(ZI),"^",2)=TPASSED
-                 . S $P(TSTS(ZI),"^",3)=TFAILED
-                 F ZI=1:1:TSTS(0) D  ;
-                 . W "TEST=> ",$P(TSTS(ZI),"^",1)
-                 . W " PASSED=>",$P(TSTS(ZI),"^",2)
-                 . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-                 W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-                 Q
-                 ;
+        N ZI,J,TZTMP,TSTS,TOTP,TOTF
+        S TOTP=0 S TOTF=0
+        D ZLOAD^C0CUNIT("TZTMP",RNM)
+        D GTSTS(.TZTMP,"TSTS")
+        F ZI=1:1:TSTS(0) D  ;
+        . S TPASSED=0 S TFAILED=0
+        . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
+        . S TOTP=TOTP+TPASSED
+        . S TOTF=TOTF+TFAILED
+        . S $P(TSTS(ZI),"^",2)=TPASSED
+        . S $P(TSTS(ZI),"^",3)=TFAILED
+        F ZI=1:1:TSTS(0) D  ;
+        . W "TEST=> ",$P(TSTS(ZI),"^",1)
+        . W " PASSED=>",$P(TSTS(ZI),"^",2)
+        . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+        W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+        Q
+        ;
 TLIST(ZARY)     ; LIST ALL THE TESTS
-                 ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-                 ; ZARY IS PASSED BY REFERENCE
-                 N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-                 S K=1
-                 F J=0:0  Q:I=""  D
-                 . ; W "I IS NOW=",I,!
-                 . W I," "
-                 . S I=$O(ZARY("TESTS",I))
-                 . S K=K+1 I K=6  D
-                 . . W !
-                 . . S K=1
-                 Q
-                 ;
-MEDS    
+        ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
+        ; ZARY IS PASSED BY REFERENCE
+        N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+        S K=1
+        F J=0:0  Q:I=""  D
+        . ; W "I IS NOW=",I,!
+        . W I," "
+        . S I=$O(ZARY("TESTS",I))
+        . S K=K+1 I K=6  D
+        . . W !
+        . . S K=1
+        Q
+        ;
+MEDS    ;
         N DEBUG S DEBUG=0
         N DFN S DFN=5685
@@ -172 +170 @@
         D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
         Q
-PAT     
+PAT     ;
         D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
         N X,Y

ccr/trunk/p/C0CUTIL.m

@@ -1 +1 @@
 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008-2009 Sam Habiel & George Lilly.  
-        ;Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "No Entry at Top!"
@@ -23 +20 @@
         ;
 UUID()   ; thanks to Wally for this.
-               N R,I,J,N 
-               S N="",R="" F  S N=N_$R(100000) Q:$L(N)>64 
-               F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1)) 
-               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)
+        N R,I,J,N
+        S N="",R="" F  S N=N_$R(100000) Q:$L(N)>64
+        F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))
+        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)
         ;
 OLDUUID()       ; GENERATE A RANDOM UUID (Version 4)
@@ -40 +37 @@
         ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
         ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
-        N UTC,Y,M,D,H,MM,S,OFF
+        N UTC,Y,M,D,H,MM,S,OFF,OFFS,OFF0,OFF1,OFF2
         S Y=1700+$E(DATE,1,3)
         S M=$E(DATE,4,5)
@@ -173 +170 @@
 OV()    ; Are we running on OpenVista?
         Q $G(DUZ("AG"))="O" ; Code for OpenVista
-        

ccr/trunk/p/C0CVA200.m

@@ -1 +1 @@
 C0CVA200        ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 Sam Habiel.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 Sam Habiel.  
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         Q
         ; This routine uses Kernel APIs and Direct Global Access to get

ccr/trunk/p/C0CVALID.m

@@ -1 +1 @@
 C0CVALID        ; C0C/OHUM/RUT - PROCESSING FOR DATE LIMITS, NOTES ; 22/12/2011
-        ;;1.2;C0C;;May 11, 2012;Build 47;Build 2
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50;Build 2
+        ; (C) RUT 2011.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
         S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")=""
         S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y

ccr/trunk/p/C0CVIT2.m

@@ -1 +1 @@
 C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -66 +63 @@
         I '$D(VIT) S @VITOUT@(0)=0 K VIT Q  ; RETURN NOT FOUND, KILL ARRAY AND QUIT
         I $P(VIT(1),U,2)="No vitals found." D  Q  ; signal no vitals and quit
-        . I $D(VITOUT) S @VITOUT@(0)=0 
+        . I $D(VITOUT) S @VITOUT@(0)=0
         . K VIT
         ;
@@ -168 +165 @@
         Q
         ;
-HEIGHT  
+HEIGHT  ;
         I DEBUG W "IN VITAL:  HEIGHT",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
@@ -185 +182 @@
         Q
         ;
-WEIGHT  
+WEIGHT  ;
         I DEBUG W "IN VITAL:  WEIGHT",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -202 +199 @@
         Q
         ;
-BP      
+BP      ;
         I DEBUG W "IN VITAL:  BLOOD PRESSURE",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -219 +216 @@
         Q
         ;
-TMP     
+TMP     ;
         I DEBUG W "IN VITAL:  TEMPERATURE",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -236 +233 @@
         Q
         ;
-RESP    
+RESP    ;
         I DEBUG W "IN VITAL:  RESPIRATION",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -253 +250 @@
         Q
         ;
-PULSE   
+PULSE   ;
         I DEBUG W "IN VITAL:  PULSE",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -270 +267 @@
         Q
         ;
-PAIN    
+PAIN    ;
         I DEBUG W "IN VITAL:  PAIN",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -287 +284 @@
         Q
         ;
-OTHER   
+OTHER   ;
         I DEBUG W "IN VITAL:  OTHER",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -305 +302 @@
         ;
         ;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
-HEIGHT1(DT,ACTOR,VALUE,UNIT)    
+HEIGHT1(DT,ACTOR,VALUE,UNIT)    ;
         I DEBUG W "IN VITAL:  HEIGHT",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
@@ -322 +319 @@
         Q
         ;
-WEIGHT1(DT,ACTOR,VALUE,UNIT)    
+WEIGHT1(DT,ACTOR,VALUE,UNIT)    ;
         I DEBUG W "IN VITAL:  WEIGHT",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -339 +336 @@
         Q
         ;
-BP1(DT,ACTOR,VALUE,UNIT)        
+BP1(DT,ACTOR,VALUE,UNIT)        ;
         I DEBUG W "IN VITAL:  BLOOD PRESSURE",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -356 +353 @@
         Q
         ;
-TMP1(DT,ACTOR,VALUE,UNIT)       
+TMP1(DT,ACTOR,VALUE,UNIT)       ;
         I DEBUG W "IN VITAL:  TEMPERATURE",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -373 +370 @@
         Q
         ;
-RESP1(DT,ACTOR,VALUE,UNIT)      
+RESP1(DT,ACTOR,VALUE,UNIT)      ;
         I DEBUG W "IN VITAL:  RESPIRATION",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -390 +387 @@
         Q
         ;
-PULSE1(DT,ACTOR,VALUE,UNIT)     
+PULSE1(DT,ACTOR,VALUE,UNIT)     ;
         I DEBUG W "IN VITAL:  PULSE",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -407 +404 @@
         Q
         ;
-PAIN1(DT,ACTOR,VALUE,UNIT)      
+PAIN1(DT,ACTOR,VALUE,UNIT)      ;
         I DEBUG W "IN VITAL:  PAIN",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
@@ -424 +421 @@
         Q
         ;
-OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)        
+OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)        ;
         I DEBUG W "IN VITAL:  OTHER",!
         S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC

ccr/trunk/p/C0CVITAL.m

@@ -1 +1 @@
 C0CVITAL        ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
-        ;Licensed under the terms of the GNU General Public License.
-        ;See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "NO ENTRY FROM TOP",!
@@ -57 +53 @@
         K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
         N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-        D VITDVISTA(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
-        I DEBUG ZWR VDATES ;DEBUG
+        D SORTVIST(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+        ; I DEBUG ZWR VDATES ;DEBUG
         S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
         ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
@@ -239 +235 @@
         K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
         N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-        D VITDRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+        D SORTRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
         S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
         ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
@@ -386 +382 @@
         Q
         ;
-VITDRPMS(VDT)   ; RUN DATE SORTING ALGORITHM FOR RPMS
+SORTRPMS(VDT)   ; RUN DATE SORTING ALGORITHM FOR RPMS
         ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
         ; OF DATES IN THE VITALS RESULTS
@@ -399 +395 @@
         Q
         ;
-VITDVISTA(VDT)  ; RUN DATE SORTING ALGORITHM FOR VISTA
+SORTVIST(VDT)   ; RUN DATE SORTING ALGORITHM FOR VISTA
         ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
         ; OF DATES IN THE VITALS RESULTS

ccr/trunk/p/C0CVOBX1.m

@@ -1 +1 @@
 LA7VOBX1        ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
         ; JMC - mods to check for IHS V LAB file
+        ;
+        ; (C) 2009 John McCormack
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
 CH      ; Observation/Result segment for "CH" subscript results.

ccr/trunk/p/C0CVORU.m

@@ -1 +1 @@
 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
-        ;;1.2;C0C;;May 11, 2012;Build 47
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;
+        ; (C) 2009 John McCormack
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
 EN(LA)  ; called from C0CVLAB

ccr/trunk/p/C0CXEWD.m

@@ -1 +1 @@
 C0CXEWD   ; C0C/GPL - EWD based XPath utilities; 10/11/09
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2009 George Lilly.  
         ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
         ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
         ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         Q

ccr/trunk/p/C0CXPAT0.m

@@ -1 +1 @@
 C0CXPAT0          ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-        ;
-               W "NO ENTRY",!
-               Q
-               ;
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+        ;
+        W "NO ENTRY",!
+        Q
+        ;
         ;;><TEST>
         ;;><INIT>

ccr/trunk/p/C0CXPATH.m

@@ -1 +1 @@
 C0CXPATH          ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-        ;;1.2;C0C;;May 11, 2012;Build 47
-        ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
-        ;General Public License See attached copy of the License.
-        ;
-        ;This program is free software; you can redistribute it and/or modify
-        ;it under the terms of the GNU General Public License as published by
-        ;the Free Software Foundation; either version 2 of the License, or
-        ;(at your option) any later version.
-        ;
-        ;This program is distributed in the hope that it will be useful,
-        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-        ;GNU General Public License for more details.
-        ;
-        ;You should have received a copy of the GNU General Public License along
-        ;with this program; if not, write to the Free Software Foundation, Inc.,
-        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
+        ;Copyright 2008 George Lilly.  
+        ;
+        ; This program is free software: you can redistribute it and/or modify
+        ; it under the terms of the GNU Affero General Public License as
+        ; published by the Free Software Foundation, either version 3 of the
+        ; License, or (at your option) any later version.
+        ;
+        ; This program is distributed in the hope that it will be useful,
+        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        ; GNU Affero General Public License for more details.
+        ;
+        ; You should have received a copy of the GNU Affero General Public License
+        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
         ;
         W "This is an XML XPATH utility library",!
@@ -135 +133 @@
         Q
         ;
-DO      
+DO      ;
         D XPG2XML("^GPL2B","^GPL2A")
         Q
@@ -188 +186 @@
         Q
         ;
-ZXO(WHAT)       
+ZXO(WHAT)       ;
         D PUSH("GA",WHAT)
         D PUSH(OUTXML,"<"_WHAT_">")
         Q
         ;
-ZXC(WHAT)       
+ZXC(WHAT)       ;
         D POP("GA",.TMP)
         D PUSH(OUTXML,"</"_WHAT_">")
         Q
         ;
-ZXVAL(WHAT,VAL) 
+ZXVAL(WHAT,VAL)  ;
         D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
         Q
@@ -235 +233 @@
         . S LINE=@IZXML@(I)
         . I $D(TEMPLATE) D  ;IF TEMPLATE IS REQUESTED
-        . . S @TEMPLATE@(I)=$$CLEAN(LINE) 
+        . . S @TEMPLATE@(I)=$$CLEAN(LINE)
         . ;W LINE,!
         . S FOUND=0  ; INTIALIZED FOUND FLAG