Index: ccr/trunk/p/C0CACTOR.m =================================================================== --- ccr/trunk/p/C0CACTOR.m (revision 1565) +++ ccr/trunk/p/C0CACTOR.m (revision 1586) @@ -1,21 +1,18 @@ -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 . ; ; PROCESS THE ACTORS SECTION OF THE CCR Index: ccr/trunk/p/C0CALERT.m =================================================================== --- ccr/trunk/p/C0CALERT.m (revision 1565) +++ ccr/trunk/p/C0CALERT.m (revision 1586) @@ -1,21 +1,19 @@ -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 . + ; ; W "NO ENTRY FROM TOP",! @@ -30,5 +28,5 @@ 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 Index: ccr/trunk/p/C0CBAT.m =================================================================== --- ccr/trunk/p/C0CBAT.m (revision 1565) +++ ccr/trunk/p/C0CBAT.m (revision 1586) @@ -1,20 +1,19 @@ 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 . + ; ; W "This is the CCR Batch Utility Library ",! @@ -63,5 +62,5 @@ 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,5 +163,5 @@ 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,8 +189,5 @@ 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 Index: ccr/trunk/p/C0CCCD.m =================================================================== --- ccr/trunk/p/C0CCCD.m (revision 1565) +++ ccr/trunk/p/C0CCCD.m (revision 1586) @@ -1,244 +1,241 @@ 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 . ; ; 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)="" ; CAP WITH CCR ROOT - S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO - S @CCDGLO@(@CCDGLO@(0))="" ; FINISH CAP - S @TGLOBAL@(@TGLOBAL@(0))="" ; 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)["" D ; REPLACE BODY MARKUP - . . . S @CCDGLO@(I)="" ; WITH CCD EQ - . . I @CCDGLO@(I)["" D ; REPLACE BODY MARKUP - . . . S @CCDGLO@(I)="" - 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)="" ; CAP WITH CCR ROOT + S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO + S @CCDGLO@(@CCDGLO@(0))="" ; FINISH CAP + S @TGLOBAL@(@TGLOBAL@(0))="" ; 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)["" D ; REPLACE BODY MARKUP + . . . S @CCDGLO@(I)="" ; WITH CCD EQ + . . I @CCDGLO@(I)["" D ; REPLACE BODY MARKUP + . . . S @CCDGLO@(I)="" + 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"".E D ; THERE IS AN ACTOR THIS LINE - . . S J=$P($P(@AXML@(I),"",2),"",1) - . . W "=>",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"".E D ; THERE IS AN ACTOR THIS LINE + . . S J=$P($P(@AXML@(I),"",2),"",1) + . . W "=>",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 + ; ;;> ;;> Index: ccr/trunk/p/C0CCCD1.m =================================================================== --- ccr/trunk/p/C0CCCD1.m (revision 1565) +++ ccr/trunk/p/C0CCCD1.m (revision 1586) @@ -1,68 +1,66 @@ 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 . + ; + ; + 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";".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";".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 ; ;; Index: ccr/trunk/p/C0CCCR.m =================================================================== --- ccr/trunk/p/C0CCCR.m (revision 1565) +++ ccr/trunk/p/C0CCCR.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; ; EXPORT A CCR @@ -288,4 +285,2 @@ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") ;;>>?@C0C@(@C0C@(0))["" - - Index: ccr/trunk/p/C0CCCR0.m =================================================================== --- ccr/trunk/p/C0CCCR0.m (revision 1565) +++ ccr/trunk/p/C0CCCR0.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; W "This is a CCR TEMPLATE with processing routines",! Index: ccr/trunk/p/C0CCMT.m =================================================================== --- ccr/trunk/p/C0CCMT.m (revision 1565) +++ ccr/trunk/p/C0CCMT.m (revision 1586) @@ -1,21 +1,19 @@ 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 . + ; ; W "NO ENTRY FROM TOP",! Index: ccr/trunk/p/C0CCPT.m =================================================================== --- ccr/trunk/p/C0CCPT.m (revision 1565) +++ ccr/trunk/p/C0CCPT.m (revision 1586) @@ -1,7 +1,19 @@ 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 . + ; ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES ;DFN=PATIENT IEN @@ -10,33 +22,33 @@ ;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" ;SET NOTE TO BE DELETED + . I $G(ENDDT)]"" D + .. I ENDDT
. ; W "This is the CCR Dictionary Utility Library ",! Index: ccr/trunk/p/C0CDOM.m =================================================================== --- ccr/trunk/p/C0CDOM.m (revision 1565) +++ ccr/trunk/p/C0CDOM.m (revision 1586) @@ -1,24 +1,23 @@ -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 . + ; + ; + 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,5 +81,5 @@ 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,5 +87,5 @@ 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,11 +94,11 @@ 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,5 +106,5 @@ 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,8 +115,8 @@ 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,5 +125,5 @@ 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,5 +136,5 @@ 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 Index: ccr/trunk/p/C0CDPT.m =================================================================== --- ccr/trunk/p/C0CDPT.m (revision 1565) +++ ccr/trunk/p/C0CDPT.m (revision 1586) @@ -1,16 +1,20 @@ 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 . + ; ; ; FAMILY Family Name Index: ccr/trunk/p/C0CENC.m =================================================================== --- ccr/trunk/p/C0CENC.m (revision 1565) +++ ccr/trunk/p/C0CENC.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -155,5 +152,5 @@ ; 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) Index: ccr/trunk/p/C0CENV.m =================================================================== --- ccr/trunk/p/C0CENV.m (revision 1565) +++ ccr/trunk/p/C0CENV.m (revision 1586) @@ -1,4 +1,19 @@ 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 . ; ; Index: ccr/trunk/p/C0CEVC.m =================================================================== --- ccr/trunk/p/C0CEVC.m (revision 1565) +++ ccr/trunk/p/C0CEVC.m (revision 1586) @@ -1,4 +1,20 @@ -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 . + ; gpltest2 ; experiment with sending a CCR to an ewd page N ZI Index: ccr/trunk/p/C0CEWD.m =================================================================== --- ccr/trunk/p/C0CEWD.m (revision 1565) +++ ccr/trunk/p/C0CEWD.m (revision 1586) @@ -1,20 +1,19 @@ 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 . ; Q Index: ccr/trunk/p/C0CEWD1.m =================================================================== --- ccr/trunk/p/C0CEWD1.m (revision 1565) +++ ccr/trunk/p/C0CEWD1.m (revision 1586) @@ -1,20 +1,17 @@ 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 . ; Q Index: ccr/trunk/p/C0CFM1.m =================================================================== --- ccr/trunk/p/C0CFM1.m (revision 1565) +++ ccr/trunk/p/C0CFM1.m (revision 1586) @@ -1,20 +1,19 @@ 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 . + ; ; W "This is the CCR FILEMAN Utility Library ",! @@ -69,5 +68,5 @@ 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,"")) Index: ccr/trunk/p/C0CFM2.m =================================================================== --- ccr/trunk/p/C0CFM2.m (revision 1565) +++ ccr/trunk/p/C0CFM2.m (revision 1586) @@ -1,20 +1,19 @@ 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 . + ; ; W "This is the CCR FILEMAN Utility Library ",! @@ -149,8 +148,5 @@ 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,5 +179,5 @@ . . W ZCHK,! . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK - ZWR ^TMP("C0CCHK",ZPAT,*) + ; ZWR ^TMP("C0CCHK",ZPAT,*) Q ; @@ -224,5 +220,5 @@ 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,9 +245,8 @@ ;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,8 +266,5 @@ 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 Index: ccr/trunk/p/C0CFM3.m =================================================================== --- ccr/trunk/p/C0CFM3.m (revision 1565) +++ ccr/trunk/p/C0CFM3.m (revision 1586) @@ -1,20 +1,19 @@ 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 . + ; ; W "This is the CCR FILEMAN Utility Library ",! @@ -135,12 +134,9 @@ 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,5 +163,5 @@ ;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,8 +185,5 @@ 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,5 +276,6 @@ 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 + ; Index: ccr/trunk/p/C0CIM2.m =================================================================== --- ccr/trunk/p/C0CIM2.m (revision 1565) +++ ccr/trunk/p/C0CIM2.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; W "NO ENTRY FROM TOP",! Index: ccr/trunk/p/C0CIMMU.m =================================================================== --- ccr/trunk/p/C0CIMMU.m (revision 1565) +++ ccr/trunk/p/C0CIMMU.m (revision 1586) @@ -1,22 +1,18 @@ 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 . ; ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR Index: ccr/trunk/p/C0CIN.m =================================================================== --- ccr/trunk/p/C0CIN.m (revision 1565) +++ ccr/trunk/p/C0CIN.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "This is the CCR Import Utility Library ",! @@ -185,8 +183,5 @@ 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 Index: ccr/trunk/p/C0CLA7DD.m =================================================================== --- ccr/trunk/p/C0CLA7DD.m (revision 1565) +++ ccr/trunk/p/C0CLA7DD.m (revision 1586) @@ -1,7 +1,21 @@ -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 . + ; ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file. - ; + ; Q ; @@ -249,11 +263,11 @@ ; ; -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 Index: ccr/trunk/p/C0CLA7Q.m =================================================================== --- ccr/trunk/p/C0CLA7Q.m (revision 1565) +++ ccr/trunk/p/C0CLA7Q.m (revision 1586) @@ -1,4 +1,19 @@ -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 . ; ; Index: ccr/trunk/p/C0CLABS.m =================================================================== --- ccr/trunk/p/C0CLABS.m (revision 1565) +++ ccr/trunk/p/C0CLABS.m (revision 1586) @@ -1,22 +1,19 @@ 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 . + ; 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,5 +61,5 @@ 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,5 +104,5 @@ . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ; . ;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)) ; Index: ccr/trunk/p/C0CMAIL.m =================================================================== --- ccr/trunk/p/C0CMAIL.m (revision 1565) +++ ccr/trunk/p/C0CMAIL.m (revision 1586) @@ -1,23 +1,20 @@ -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 . ; ; ------------------ Index: ccr/trunk/p/C0CMAIL2.m =================================================================== --- ccr/trunk/p/C0CMAIL2.m (revision 1565) +++ ccr/trunk/p/C0CMAIL2.m (revision 1586) @@ -1,23 +1,20 @@ 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 . ; ; ------------------ Index: ccr/trunk/p/C0CMAIL3.m =================================================================== --- ccr/trunk/p/C0CMAIL3.m (revision 1565) +++ ccr/trunk/p/C0CMAIL3.m (revision 1586) @@ -1,23 +1,20 @@ 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 . ; ; ------------------ Index: ccr/trunk/p/C0CMCCD.m =================================================================== --- ccr/trunk/p/C0CMCCD.m (revision 1565) +++ ccr/trunk/p/C0CMCCD.m (revision 1586) @@ -1,20 +1,18 @@ -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 . ; Q @@ -281,12 +279,9 @@ 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 Index: ccr/trunk/p/C0CMED.m =================================================================== --- ccr/trunk/p/C0CMED.m (revision 1565) +++ ccr/trunk/p/C0CMED.m (revision 1586) @@ -1,21 +1,19 @@ 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 . + ; ; ; --Revision History @@ -53,5 +51,5 @@ 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,13 +60,13 @@ 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,18 +86,18 @@ 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,3 +110,2 @@ K @IPUD Q - Index: ccr/trunk/p/C0CMED1.m =================================================================== --- ccr/trunk/p/C0CMED1.m (revision 1565) +++ ccr/trunk/p/C0CMED1.m (revision 1586) @@ -1,21 +1,19 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -58,10 +56,10 @@ ; 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,! Index: ccr/trunk/p/C0CMED2.m =================================================================== --- ccr/trunk/p/C0CMED2.m (revision 1565) +++ ccr/trunk/p/C0CMED2.m (revision 1586) @@ -1,21 +1,19 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -48,5 +46,5 @@ ; 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 Index: ccr/trunk/p/C0CMED3.m =================================================================== --- ccr/trunk/p/C0CMED3.m (revision 1565) +++ ccr/trunk/p/C0CMED3.m (revision 1586) @@ -1,21 +1,19 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -49,5 +47,5 @@ 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 Index: ccr/trunk/p/C0CMED4.m =================================================================== --- ccr/trunk/p/C0CMED4.m (revision 1565) +++ ccr/trunk/p/C0CMED4.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -49,8 +47,8 @@ ; 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,5 +59,5 @@ . 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,5 +68,5 @@ . 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,5 +112,5 @@ . . 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,7 +124,7 @@ . 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,5 +141,5 @@ . 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")="" Index: ccr/trunk/p/C0CMED6.m =================================================================== --- ccr/trunk/p/C0CMED6.m (revision 1565) +++ ccr/trunk/p/C0CMED6.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -55,5 +53,5 @@ ; 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,5 +227,5 @@ . . 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,5 +263,5 @@ . ; -- 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,5 +310,5 @@ 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,3 +327,2 @@ . . 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 - Index: ccr/trunk/p/C0CMIME.m =================================================================== --- ccr/trunk/p/C0CMIME.m (revision 1565) +++ ccr/trunk/p/C0CMIME.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; Q @@ -45,5 +43,5 @@ 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,8 +68,8 @@ 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,5 +83,5 @@ ;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,5 +97,5 @@ S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE" D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml") - ZWR GR + ; ZWR GR Q ; @@ -203,5 +201,5 @@ Q ; -MAILSEND0(LRMSUBJ) ; Send extract back to requestor. +MAILSEN0(LRMSUBJ) ; Send extract back to requestor. ; ;D TEST @@ -251,5 +249,5 @@ Q ; -MAILSEND2(UDFN,ADDR) ; Send extract back to requestor. +MAILSEN2(UDFN,ADDR) ; Send extract back to requestor. ; I +$G(UDFN)=0 S UDFN=2 ; Index: ccr/trunk/p/C0CMXML.m =================================================================== --- ccr/trunk/p/C0CMXML.m (revision 1565) +++ ccr/trunk/p/C0CMXML.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; Q @@ -45,5 +43,5 @@ Q ; -TEST3 +TEST3 ; S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) K GARY,GTMP,GIDX @@ -114,5 +112,5 @@ D END^C0CMXMLB ;END THE DOCUMENT M ZCCR=^TMP("MXMLBLD",$J) - ZWR ZCCR + ; ZWR ZCCR Q ; @@ -137,5 +135,5 @@ ;D END^C0CMXMLB ;EOND THE DOCUMENT ;M ZCCD=^TMP("MXMLBLD",$J) - ZWR ZCCD(1:30) + ; ZWR ZCCD(1:30) Q ; @@ -246,8 +244,5 @@ 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 Index: ccr/trunk/p/C0CMXMLB.m =================================================================== --- ccr/trunk/p/C0CMXMLB.m (revision 1565) +++ ccr/trunk/p/C0CMXMLB.m (revision 1586) @@ -1,5 +1,7 @@ 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,5 +12,5 @@ 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("") D OUTPUT("<"_DOC_">") Q Index: ccr/trunk/p/C0CMXP.m =================================================================== --- ccr/trunk/p/C0CMXP.m (revision 1565) +++ ccr/trunk/p/C0CMXP.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; Q @@ -167,5 +165,5 @@ 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,8 +282,5 @@ 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 Index: ccr/trunk/p/C0CNHIN.m =================================================================== --- ccr/trunk/p/C0CNHIN.m (revision 1565) +++ ccr/trunk/p/C0CNHIN.m (revision 1586) @@ -1,20 +1,18 @@ -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 . ; Q @@ -146,5 +144,5 @@ 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,5 +203,5 @@ 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,5 +209,5 @@ 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,11 +216,11 @@ 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,5 +228,5 @@ 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,8 +237,8 @@ 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,5 +247,5 @@ 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,5 +257,5 @@ 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 Index: ccr/trunk/p/C0CNMED2.m =================================================================== --- ccr/trunk/p/C0CNMED2.m (revision 1565) +++ ccr/trunk/p/C0CNMED2.m (revision 1586) @@ -1,21 +1,19 @@ 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 . + ; ; ; --Revision History Index: ccr/trunk/p/C0CNMED4.m =================================================================== --- ccr/trunk/p/C0CNMED4.m (revision 1565) +++ ccr/trunk/p/C0CNMED4.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -58,17 +56,17 @@ 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,5 +78,5 @@ . 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,7 +172,7 @@ . 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,5 +189,5 @@ . 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")="" Index: ccr/trunk/p/C0CORSLT.m =================================================================== --- ccr/trunk/p/C0CORSLT.m (revision 1565) +++ ccr/trunk/p/C0CORSLT.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; W "NO ENTRY FROM TOP",! Index: ccr/trunk/p/C0COVREL.m =================================================================== --- ccr/trunk/p/C0COVREL.m (revision 1565) +++ ccr/trunk/p/C0COVREL.m (revision 1586) @@ -1,70 +1,85 @@ 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 . + ; +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 Index: ccr/trunk/p/C0COVRES.m =================================================================== --- ccr/trunk/p/C0COVRES.m (revision 1565) +++ ccr/trunk/p/C0COVRES.m (revision 1586) @@ -1,94 +1,108 @@ 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 . + ; 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) ; - 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 - . 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 - . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ; - . . . 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) ; - D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ; - 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) ; + 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 + . 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 + . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ; + . . . 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) ; + D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ; + 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 Index: ccr/trunk/p/C0COVREU.m =================================================================== --- ccr/trunk/p/C0COVREU.m (revision 1565) +++ ccr/trunk/p/C0COVREU.m (revision 1586) @@ -1,178 +1,191 @@ 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 . + ; + ; +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 Index: ccr/trunk/p/C0CPARMS.m =================================================================== --- ccr/trunk/p/C0CPARMS.m (revision 1565) +++ ccr/trunk/p/C0CPARMS.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS Index: ccr/trunk/p/C0CPROBS.m =================================================================== --- ccr/trunk/p/C0CPROBS.m (revision 1565) +++ ccr/trunk/p/C0CPROBS.m (revision 1586) @@ -1,22 +1,18 @@ 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 . ; ; PROCESS THE PROBLEMS SECTION OF THE CCR @@ -92,5 +88,5 @@ ; GENERATE THE NARITIVE HTML FOR THE CCD I CCD D CCD ; IF THIS IS FOR A CCD - D MISSINGVARS + D MISSVARS Q ; @@ -149,7 +145,7 @@ ; 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,5 +171,5 @@ 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 Index: ccr/trunk/p/C0CPROC.m =================================================================== --- ccr/trunk/p/C0CPROC.m (revision 1565) +++ ccr/trunk/p/C0CPROC.m (revision 1586) @@ -1,21 +1,17 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -112,5 +108,5 @@ ; 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) Index: ccr/trunk/p/C0CPXRM.m =================================================================== --- ccr/trunk/p/C0CPXRM.m (revision 1565) +++ ccr/trunk/p/C0CPXRM.m (revision 1586) @@ -1,74 +1,74 @@ 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 ; Index: ccr/trunk/p/C0CQRY1.m =================================================================== --- ccr/trunk/p/C0CQRY1.m (revision 1565) +++ ccr/trunk/p/C0CQRY1.m (revision 1586) @@ -1,4 +1,4 @@ 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 Index: ccr/trunk/p/C0CQRY2.m =================================================================== --- ccr/trunk/p/C0CQRY2.m (revision 1565) +++ ccr/trunk/p/C0CQRY2.m (revision 1586) @@ -1,5 +1,21 @@ -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 . + ; ; Q Index: ccr/trunk/p/C0CRAHL7.m =================================================================== --- ccr/trunk/p/C0CRAHL7.m (revision 1565) +++ ccr/trunk/p/C0CRAHL7.m (revision 1586) @@ -1,136 +1,152 @@ 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 . + ; + ; + 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 Index: ccr/trunk/p/C0CRARPT.m =================================================================== --- ccr/trunk/p/C0CRARPT.m (revision 1565) +++ ccr/trunk/p/C0CRARPT.m (revision 1586) @@ -1,166 +1,182 @@ -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))=""!($G(C0COXML(C0CRES))="") - . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) - . . S C0COCNT=C0COCNT+1 - . S C0CRSXML(C0COCNT)="" - . 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) ; - 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 - . 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 - . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ; - . . . 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) ; - D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ; - 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 . + ; +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))=""!($G(C0COXML(C0CRES))="") + . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) + . . S C0COCNT=C0COCNT+1 + . S C0CRSXML(C0COCNT)="" + . 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) ; + 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 + . 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 + . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ; + . . . 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) ; + D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ; + 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 Index: ccr/trunk/p/C0CRIMA.m =================================================================== --- ccr/trunk/p/C0CRIMA.m (revision 1565) +++ ccr/trunk/p/C0CRIMA.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE @@ -100,5 +97,5 @@ . 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,5 +383,5 @@ 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,5 +417,5 @@ 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) Index: ccr/trunk/p/C0CRNF.m =================================================================== --- ccr/trunk/p/C0CRNF.m (revision 1565) +++ ccr/trunk/p/C0CRNF.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "This is the Reference Name Format (RNF) Utility Library ",! @@ -29,5 +27,5 @@ 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,5 +51,5 @@ S G1("THREE")=3 D RNF1TO2("GPL","G1") - ZWR GPL + ; ZWR GPL Q ; Index: ccr/trunk/p/C0CRNFRP.m =================================================================== --- ccr/trunk/p/C0CRNFRP.m (revision 1565) +++ ccr/trunk/p/C0CRNFRP.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "This is the Reference Name Format (RNF) RPC Library ",! Index: ccr/trunk/p/C0CRPMS.m =================================================================== --- ccr/trunk/p/C0CRPMS.m (revision 1565) +++ ccr/trunk/p/C0CRPMS.m (revision 1586) @@ -1,20 +1,17 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -27,5 +24,5 @@ VTYPES ; D GETN2^C0CRNF("G1",9999999.07) - ZWR G1 + ; ZWR G1 Q ; @@ -92,5 +89,5 @@ . 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 Index: ccr/trunk/p/C0CRXN.m =================================================================== --- ccr/trunk/p/C0CRXN.m (revision 1565) +++ ccr/trunk/p/C0CRXN.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "This is the CCR RXNORM Utility Library ",! @@ -53,5 +51,5 @@ . . ;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,5 +72,5 @@ . 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,5 +148,5 @@ . 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,4 +214,5 @@ Q ; + D . I $$ZVALUE("MEDIATION CODE")="" D . . S NORXN=NORXN+1 ; @@ -225,5 +224,5 @@ . . ;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,5 +244,5 @@ . 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,! Index: ccr/trunk/p/C0CRXNRD.m =================================================================== --- ccr/trunk/p/C0CRXNRD.m (revision 1565) +++ ccr/trunk/p/C0CRXNRD.m (revision 1586) @@ -1,6 +1,21 @@ 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 . + ; W "No entry from top" Q -IMPORT(PATH) +IMPORT(PATH) ; Main entry point I PATH="" QUIT D READSRC(PATH),READCON(PATH),READNDC(PATH) @@ -21,5 +36,5 @@ 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,5 +52,5 @@ 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,5 +97,5 @@ 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,5 +121,5 @@ 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,3 +156,2 @@ EX3 D CLOSE^%ZISH("FILE") Q - Index: ccr/trunk/p/C0CSNOA.m =================================================================== --- ccr/trunk/p/C0CSNOA.m (revision 1565) +++ ccr/trunk/p/C0CSNOA.m (revision 1586) @@ -1,66 +1,59 @@ 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 . ; 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,109 +64,109 @@ ; 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,5 +176,5 @@ 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) Index: ccr/trunk/p/C0CSOAP.m =================================================================== --- ccr/trunk/p/C0CSOAP.m (revision 1565) +++ ccr/trunk/p/C0CSOAP.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "This is an SOAP utility library",! Index: ccr/trunk/p/C0CSQMB.m =================================================================== --- ccr/trunk/p/C0CSQMB.m (revision 1565) +++ ccr/trunk/p/C0CSQMB.m (revision 1586) @@ -1,4 +1,18 @@ 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 . ; EN ;Traverse the DPT global and export CCR xml for each DFN Index: ccr/trunk/p/C0CSUB1.m =================================================================== --- ccr/trunk/p/C0CSUB1.m (revision 1565) +++ ccr/trunk/p/C0CSUB1.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "This is the CCR SUBSCRIPTIONN Utility Library ",! @@ -29,12 +27,12 @@ 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,8 +68,5 @@ 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 Index: ccr/trunk/p/C0CSYS.m =================================================================== --- ccr/trunk/p/C0CSYS.m (revision 1565) +++ ccr/trunk/p/C0CSYS.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "Enter at appropriate points." Q Index: ccr/trunk/p/C0CTIU.m =================================================================== --- ccr/trunk/p/C0CTIU.m (revision 1565) +++ ccr/trunk/p/C0CTIU.m (revision 1586) @@ -1,5 +1,18 @@ 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 . ; ;ELN - Modified Routine of C0CLABS Index: ccr/trunk/p/C0CTIU1.m =================================================================== --- ccr/trunk/p/C0CTIU1.m (revision 1565) +++ ccr/trunk/p/C0CTIU1.m (revision 1586) @@ -1,5 +1,20 @@ 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 . + ; C0CDATE(EDTE) ; Converts external date to internal date format ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL) Index: ccr/trunk/p/C0CUNIT.m =================================================================== --- ccr/trunk/p/C0CUNIT.m (revision 1565) +++ ccr/trunk/p/C0CUNIT.m (revision 1586) @@ -1,159 +1,157 @@ 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 . ; - 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";;>".E S INTEST=1 ; entering test section - . I LINE?." "1";;>".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";;>".E S INTEST=1 ; entering test section + . I LINE?." "1";;>".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 ;;> 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 ;;> 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,5 +170,5 @@ D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml") Q -PAT +PAT ; D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory N X,Y Index: ccr/trunk/p/C0CUTIL.m =================================================================== --- ccr/trunk/p/C0CUTIL.m (revision 1565) +++ ccr/trunk/p/C0CUTIL.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; W "No Entry at Top!" @@ -23,8 +20,8 @@ ; 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,5 +37,5 @@ ; 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,3 +170,2 @@ OV() ; Are we running on OpenVista? Q $G(DUZ("AG"))="O" ; Code for OpenVista - Index: ccr/trunk/p/C0CVA200.m =================================================================== --- ccr/trunk/p/C0CVA200.m (revision 1565) +++ ccr/trunk/p/C0CVA200.m (revision 1586) @@ -1,20 +1,19 @@ 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 . + ; Q ; This routine uses Kernel APIs and Direct Global Access to get Index: ccr/trunk/p/C0CVALID.m =================================================================== --- ccr/trunk/p/C0CVALID.m (revision 1565) +++ ccr/trunk/p/C0CVALID.m (revision 1586) @@ -1,4 +1,19 @@ 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 . + ; 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 Index: ccr/trunk/p/C0CVIT2.m =================================================================== --- ccr/trunk/p/C0CVIT2.m (revision 1565) +++ ccr/trunk/p/C0CVIT2.m (revision 1586) @@ -1,21 +1,18 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -66,5 +63,5 @@ 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,5 +165,5 @@ Q ; -HEIGHT +HEIGHT ; I DEBUG W "IN VITAL: HEIGHT",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID @@ -185,5 +182,5 @@ Q ; -WEIGHT +WEIGHT ; I DEBUG W "IN VITAL: WEIGHT",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -202,5 +199,5 @@ Q ; -BP +BP ; I DEBUG W "IN VITAL: BLOOD PRESSURE",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -219,5 +216,5 @@ Q ; -TMP +TMP ; I DEBUG W "IN VITAL: TEMPERATURE",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -236,5 +233,5 @@ Q ; -RESP +RESP ; I DEBUG W "IN VITAL: RESPIRATION",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -253,5 +250,5 @@ Q ; -PULSE +PULSE ; I DEBUG W "IN VITAL: PULSE",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -270,5 +267,5 @@ Q ; -PAIN +PAIN ; I DEBUG W "IN VITAL: PAIN",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -287,5 +284,5 @@ Q ; -OTHER +OTHER ; I DEBUG W "IN VITAL: OTHER",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -305,5 +302,5 @@ ; ;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,5 +319,5 @@ Q ; -WEIGHT1(DT,ACTOR,VALUE,UNIT) +WEIGHT1(DT,ACTOR,VALUE,UNIT) ; I DEBUG W "IN VITAL: WEIGHT",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -339,5 +336,5 @@ Q ; -BP1(DT,ACTOR,VALUE,UNIT) +BP1(DT,ACTOR,VALUE,UNIT) ; I DEBUG W "IN VITAL: BLOOD PRESSURE",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -356,5 +353,5 @@ Q ; -TMP1(DT,ACTOR,VALUE,UNIT) +TMP1(DT,ACTOR,VALUE,UNIT) ; I DEBUG W "IN VITAL: TEMPERATURE",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -373,5 +370,5 @@ Q ; -RESP1(DT,ACTOR,VALUE,UNIT) +RESP1(DT,ACTOR,VALUE,UNIT) ; I DEBUG W "IN VITAL: RESPIRATION",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -390,5 +387,5 @@ Q ; -PULSE1(DT,ACTOR,VALUE,UNIT) +PULSE1(DT,ACTOR,VALUE,UNIT) ; I DEBUG W "IN VITAL: PULSE",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -407,5 +404,5 @@ Q ; -PAIN1(DT,ACTOR,VALUE,UNIT) +PAIN1(DT,ACTOR,VALUE,UNIT) ; I DEBUG W "IN VITAL: PAIN",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC @@ -424,5 +421,5 @@ Q ; -OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) +OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) ; I DEBUG W "IN VITAL: OTHER",! S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC Index: ccr/trunk/p/C0CVITAL.m =================================================================== --- ccr/trunk/p/C0CVITAL.m (revision 1565) +++ ccr/trunk/p/C0CVITAL.m (revision 1586) @@ -1,21 +1,17 @@ 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 . ; W "NO ENTRY FROM TOP",! @@ -57,6 +53,6 @@ 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,5 +235,5 @@ 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,5 +382,5 @@ 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,5 +395,5 @@ 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 Index: ccr/trunk/p/C0CVOBX1.m =================================================================== --- ccr/trunk/p/C0CVOBX1.m (revision 1565) +++ ccr/trunk/p/C0CVOBX1.m (revision 1586) @@ -1,5 +1,19 @@ 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 . ; CH ; Observation/Result segment for "CH" subscript results. Index: ccr/trunk/p/C0CVORU.m =================================================================== --- ccr/trunk/p/C0CVORU.m (revision 1565) +++ ccr/trunk/p/C0CVORU.m (revision 1586) @@ -1,4 +1,18 @@ 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 . ; EN(LA) ; called from C0CVLAB Index: ccr/trunk/p/C0CXEWD.m =================================================================== --- ccr/trunk/p/C0CXEWD.m (revision 1565) +++ ccr/trunk/p/C0CXEWD.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; Q Index: ccr/trunk/p/C0CXPAT0.m =================================================================== --- ccr/trunk/p/C0CXPAT0.m (revision 1565) +++ ccr/trunk/p/C0CXPAT0.m (revision 1586) @@ -1,24 +1,22 @@ 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 . + ; + W "NO ENTRY",! + Q + ; ;;> ;;> Index: ccr/trunk/p/C0CXPATH.m =================================================================== --- ccr/trunk/p/C0CXPATH.m (revision 1565) +++ ccr/trunk/p/C0CXPATH.m (revision 1586) @@ -1,20 +1,18 @@ 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 . ; W "This is an XML XPATH utility library",! @@ -135,5 +133,5 @@ Q ; -DO +DO ; D XPG2XML("^GPL2B","^GPL2A") Q @@ -188,15 +186,15 @@ 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,"") Q ; -ZXVAL(WHAT,VAL) +ZXVAL(WHAT,VAL) ; D PUSH(OUTXML,"<"_WHAT_">"_VAL_"") Q @@ -235,5 +233,5 @@ . 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