From 0f6cf98b0ae7ce16f679d2c9fc80b454d628f00c Mon Sep 17 00:00:00 2001 From: george Date: Sat, 14 Mar 2009 22:23:22 +0000 Subject: [PATCH] name spacing the package to C0C ... removing all GPL references --- p/{GPLACTOR.m => C0CACTOR.m} | 37 +++--- p/{GPLALERT.m => C0CALERT.m} | 17 +-- p/{GPLCCD1.m => C0CCCD1.m} | 9 +- p/{GPLCCR.m => C0CCCR.m} | 137 +++++++++++----------- p/{GPLIMMU.m => C0CIMMU.m} | 33 +++--- p/{GPLLABS.m => C0CLABS.m} | 95 ++++++++-------- p/{GPLPROBS.m => C0CPROBS.m} | 63 ++++++----- p/{GPLRIMA.m => C0CRIMA.m} | 85 +++++++------- p/{GPLSNOA.m => C0CSNOA.m} | 51 ++++----- p/{GPLUNIT.m => C0CUNIT.m} | 14 +-- p/{GPLVITAL.m => C0CVITAL.m} | 21 ++-- p/C0CXPAT0.m | 212 +++++++++++++++++++++++++++++++++++ p/{GPLXPATH.m => C0CXPATH.m} | 52 ++++----- p/GPLCCD.m | 165 +++++++++++++-------------- p/GPLXPAT0.m | 212 ----------------------------------- 15 files changed, 608 insertions(+), 595 deletions(-) rename p/{GPLACTOR.m => C0CACTOR.m} (87%) rename p/{GPLALERT.m => C0CALERT.m} (91%) rename p/{GPLCCD1.m => C0CCCD1.m} (97%) rename p/{GPLCCR.m => C0CCCR.m} (61%) rename p/{GPLIMMU.m => C0CIMMU.m} (82%) rename p/{GPLLABS.m => C0CLABS.m} (86%) rename p/{GPLPROBS.m => C0CPROBS.m} (68%) rename p/{GPLRIMA.m => C0CRIMA.m} (88%) rename p/{GPLSNOA.m => C0CSNOA.m} (85%) rename p/{GPLUNIT.m => C0CUNIT.m} (94%) rename p/{GPLVITAL.m => C0CVITAL.m} (94%) create mode 100644 p/C0CXPAT0.m rename p/{GPLXPATH.m => C0CXPATH.m} (93%) delete mode 100644 p/GPLXPAT0.m diff --git a/p/GPLACTOR.m b/p/C0CACTOR.m similarity index 87% rename from p/GPLACTOR.m rename to p/C0CACTOR.m index 8a7a5ca..65c2873 100644 --- a/p/GPLACTOR.m +++ b/p/C0CACTOR.m @@ -1,7 +1,8 @@ -GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 +C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ;;0.4;CCDCCR;nopatch;noreleasedate - ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ; General Public License See attached copy of the License. + ;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 @@ -28,15 +29,15 @@ GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE ; IPXML is the Input Actor Template into which we substitute values ; This is straight XML. Values to be substituted are in @@VAL@@ format. - ; ALST is the actor list global generated by ACTLST^GPLCCR and has format: + ; ALST is the actor list global generated by ACTLST^C0CCCR and has format: ; ^TMP(7542,1,"ACTORS",0)=Count ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN" ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM" ; AXML is the output arrary, to contain XML. ; N I,J,AMAP,AOID,ATYP,AIEN - D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML - D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES + D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML + D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES I DEBUG W "PROCESSING ACTORS ",! F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR @@ -49,32 +50,32 @@ EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE . ; . I DEBUG W AOID_" "_ATYP_" "_AIEN,! . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") + . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") . . D PATIENT("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") + . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="NOK" D ; NOK ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") + . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") . . D NOK("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") + . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") + . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") . . D ORG("ATMP",AIEN,AOID,"ATMP2") . ; . W "PROCESSING:",ATYP," ",AIEN,! . ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE - . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT + . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE ; N ACTTMP - D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS + D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS - . ; STRINGS MARKED AS @@X@@ . W "ACTORS Missing list: ",! @@ -137,7 +138,7 @@ PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR S @AMAP@("ACTORIEN")=AIEN S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE - D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE + D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR @@ -149,7 +150,7 @@ SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS S @AMAP@("ACTORINFOSYSSOURCEID")=AOID - D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE + D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR @@ -162,7 +163,7 @@ NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR S @AMAP@("ACTORRELATION")="" S @AMAP@("ACTORRELATIONSOURCEID")="" S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE - D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE + D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR @@ -173,7 +174,7 @@ ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2) S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" - D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE + D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR @@ -207,6 +208,6 @@ PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN) S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1" S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE - D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE + D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; diff --git a/p/GPLALERT.m b/p/C0CALERT.m similarity index 91% rename from p/GPLALERT.m rename to p/C0CALERT.m index 5617e01..872f2af 100644 --- a/p/GPLALERT.m +++ b/p/C0CALERT.m @@ -1,7 +1,8 @@ -GPLALERT ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 +C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 ;;0.1;CCDCCR;;SEP 11,2008; - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -32,8 +33,8 @@ EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE . S @ALTOUTXML@(0)=0 ; DEFINE MAPPING N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP - S ALTTVMAP=$NA(^TMP("GPLCCR",$J,"ALERTS")) - S ALTTARYTMP=$NA(^TMP("GPLCCR",$J,"ALERTSARYTMP")) + S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS")) + S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP")) K @ALTTVMAP,@ALTTARYTMP N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1 S ALTTMP="" ; @@ -110,9 +111,9 @@ EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CT) . K @ALTARYTMP - . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP) - . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML) - . I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP) + . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) + . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) + . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP) . S ALTCNT=ALTCNT+1 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS Q diff --git a/p/GPLCCD1.m b/p/C0CCCD1.m similarity index 97% rename from p/GPLCCD1.m rename to p/C0CCCD1.m index d7d69fc..524a887 100644 --- a/p/GPLCCD1.m +++ b/p/C0CCCD1.m @@ -1,7 +1,8 @@ -GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 +C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 ;;0.1;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -57,7 +58,7 @@ ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference Q ; LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME - D ZLOAD(ARY,"GPLCCD1") + D ZLOAD(ARY,"C0CCCD1") ; ZWR @ARY Q ; diff --git a/p/GPLCCR.m b/p/C0CCCR.m similarity index 61% rename from p/GPLCCR.m rename to p/C0CCCR.m index ea8338d..1fc923c 100644 --- a/p/GPLCCR.m +++ b/p/C0CCCR.m @@ -1,7 +1,8 @@ -GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 +C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 ;;0.1;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -28,7 +29,7 @@ EXPORT ; EXPORT ENTRY POINT FOR CCR Q ; XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE - ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR") + ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") ; FN IS FILE NAME, DEFAULTS IF NULL N CCRGLO,UDIR,UFN I '$D(DIR) S UDIR="" @@ -37,28 +38,30 @@ XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE E S UFN=FN I '$D(XPARMS) S XPARMS="" D CCRRPC(.CCRGLO,DFN,XPARMS,"CCR") - S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1)) + S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1)) S ONAM=UFN - I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_18.xml" - S ODIRGLB=$NA(^TMP("GPLCCR","ODIR")) + I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_19.xml" + S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) + I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR") I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET + . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q . ;S @ODIRGLB="/home/glilly/CCROUT" . ;S @ODIRGLB="/home/cedwards/" . S @ODIRGLB="/opt/wv/p/" S ODIR=UDIR I UDIR="" S ODIR=@ODIRGLB N ZY - S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR) + S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) W !,$P(ZY,U,2),! Q ; DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED ; N G1 - S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) + S G1=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) I $D(@G1@(0)) D ; CCR EXISTS - . D PARY^GPLXPATH(G1) - E W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",! + . D PARY^C0CXPATH(G1) + E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",! Q ; CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT @@ -76,25 +79,25 @@ CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION - S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE - S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR - S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS + S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE + S CCRGLO=$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("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL - D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE - D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL + S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL + D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE + D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL ; ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES - D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") - D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") - D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") + D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") + D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") + D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! ; D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES ; - K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT - S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS + 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 PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS @@ -102,7 +105,7 @@ CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT . 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^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS + . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS . S IXML="INXML" . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY @@ -112,16 +115,16 @@ CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT . X CALL . ; NOW INSERT THE RESULTS IN THE CCR BUFFER . I @OXML@(0)'=0 D ; THERE IS A RESULT - . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") - . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! + . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") + . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING - D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST - D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") - D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2") - D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") + D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST + D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") + D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") + D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") N TRIMI,J,DONE S DONE=0 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE - . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS + . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS . I DEBUG W "TRIMMED",J,! . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE Q @@ -130,16 +133,16 @@ INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS ; TAB IS PASSED BY NAME I DEBUG W "TAB= ",TAB,! ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS - D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")") - D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")") - D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")") - D PUSH^GPLXPATH(TAB,"MAP;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")") - D PUSH^GPLXPATH(TAB,"MAP;GPLIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""GPLCCR"",$J,DFN,""IMMUNE"")") - I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")") + D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") + D PUSH^C0CXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") + D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") + D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")") + D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")") + I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")") Q ; HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT - N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER")) + N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) ; K @VMAP S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT") ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS @@ -152,12 +155,12 @@ HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT . 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^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY + ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY N CTMP - D MAP^GPLXPATH(CXML,VMAP,"CTMP") - D CP^GPLXPATH("CTMP",CXML) + D MAP^C0CXPATH(CXML,VMAP,"CTMP") + D CP^C0CXPATH("CTMP",CXML) N HRIMVARS ; - S HRIMVARS=$NA(^TMP("GPLRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS + S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT Q @@ -184,53 +187,53 @@ ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML . 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^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY + . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY Q ; TEST ; RUN ALL THE TEST CASES - D TESTALL^GPLUNIT("GPLCCR") + D TESTALL^C0CUNIT("C0CCCR") Q ; ZTEST(WHICH) ; RUN ONE SET OF TESTS N ZTMP - D ZLOAD^GPLUNIT("ZTMP","GPLCCR") - D ZTEST^GPLUNIT(.ZTMP,WHICH) + D ZLOAD^C0CUNIT("ZTMP","C0CCCR") + D ZTEST^C0CUNIT(.ZTMP,WHICH) Q ; TLIST ; LIST THE TESTS N ZTMP - D ZLOAD^GPLUNIT("ZTMP","GPLCCR") - D TLIST^GPLUNIT(.ZTMP) + D ZLOAD^C0CUNIT("ZTMP","C0CCCR") + D TLIST^C0CUNIT(.ZTMP) Q ; ;;> ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","") + ;;>>?@C0C@(@C0C@(0))["" ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","") + ;;>>?@C0C@(@C0C@(0))["" ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") + ;;>>?@C0C@(@C0C@(0))["" ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") - ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST") + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") + ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") ;;> - ;;>>>D ZTEST^GPLCCR("ACTLST") - ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") - ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3") + ;;>>>D ZTEST^C0CCCR("ACTLST") + ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") + ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") ;;>>?G3(G3(0))["" ;;> - ;;>>>D ZTEST^GPLCCR("CCR") - ;;>>>W $$TRIM^GPLXPATH(CCRGLO) + ;;>>>D ZTEST^C0CCCR("CCR") + ;;>>>W $$TRIM^C0CXPATH(CCRGLO) ;;> ;;>>>S TESTALERT=1 - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") + ;;>>?@C0C@(@C0C@(0))["" diff --git a/p/GPLIMMU.m b/p/C0CIMMU.m similarity index 82% rename from p/GPLIMMU.m rename to p/C0CIMMU.m index 0e34ba1..1ed977d 100644 --- a/p/GPLIMMU.m +++ b/p/C0CIMMU.m @@ -1,7 +1,8 @@ -GPLIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09 +C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09 ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7 - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -24,21 +25,21 @@ MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS ; N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES N C0CZT ; TMP ARRAY OF MAPPED XML - S C0CZV=$NA(^TMP("GPLCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES + S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY - I C0CZIC>0 D ;IMMUNIZATIONS FOUND + I C0CZIC>0 D ;IMMUNIZATIONS FOUND . F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION - . . D MAP^GPLXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML + . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML . . I C0CZI=1 D ; FIRST ONE - . . . D CP^GPLXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS + . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS . . E D ;NOT THE FIRST - . . . D INSINNER^GPLXPATH(OUTXML,"C0CZT") + . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT") E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS N IMMUTMP,I - D MISSING^GPLXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS + D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS - . ; STRINGS MARKED AS @@X@@ . W !,"IMMUNE Missing list: ",! @@ -51,11 +52,11 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS - ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT + ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT ; N RPCRSLT,J,K,PTMP,X,VMAP,TBU - S TVMAP=$NA(^TMP("GPLCCR",$J,"IMMUNE")) - S TARYTMP=$NA(^TMP("GPLCCR",$J,"IMMUARYTMP")) + S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE")) + S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP")) S IMMA=$NA(^TMP("PXI",$J)) ; K @IMMA ; CLEAR OUT PREVIOUS RESULTS K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES @@ -63,7 +64,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL . W "NULL RESULT FROM IMMUN^PXRHS03 ",! . S @TVMAP@(0)=0 - N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ; + N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ; S C0CIM="" S C0CC=0 ; COUNT F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST @@ -88,8 +89,8 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES . . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD - . . . ; FOR LOOKING UP THE CODE - . . . ; GET IT FROM THE CODE FILE + . . . ; FOR LOOKING UP THE CODE + . . . ; GET IT FROM THE CODE FILE . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE @@ -100,7 +101,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE - N C0CIRIM S C0CIRIM=$NA(^TMP("GPLRIM","VARS",DFN,"IMMUNE")) + N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE")) M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES Q ; diff --git a/p/GPLLABS.m b/p/C0CLABS.m similarity index 86% rename from p/GPLLABS.m rename to p/C0CLABS.m index c733a89..765ddbf 100644 --- a/p/GPLLABS.m +++ b/p/C0CLABS.m @@ -1,7 +1,8 @@ -GPLALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 +C0CALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ;;0.3;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -30,7 +31,7 @@ MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 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("GPLCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT + I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT E S C0CO=MOXML ; ZWR C0COXML M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT @@ -42,29 +43,29 @@ RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS ;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^GPLCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE - . D QUERY^GPLXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") + . 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("GPLCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION + . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS - D CP^GPLXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE - D REPLACE^GPLXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ - D QUERY^GPLXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE + 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 I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT I 'C0CQT D ; WE ARE DEBUGGING . W "I MAPPED",! . W "VARS:",C0CV,! . W "DFN:",DFN,! - . ;D PARY^GPLXPATH("C0CT") ; SECTION TEMPLATE - . ;D PARY^GPLXPATH("C0CRT") ;REQUEST TEMPLATE (OCR) - . ;D PARY^GPLXPATH("C0CTT") ;TEST TEMPLATE (OCX) + . ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE + . ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR) + . ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX) 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 I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS - S RIMVARS=$NA(^TMP("GPLRIM","VARS",DFN,"RESULTS")) + S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) K @RIMVARS M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP @@ -73,16 +74,16 @@ RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 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^GPLXPATH("C0CRBLD","C0CRT",1,1) ; + 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)) ; . I 'C0CQT W "MAPOBR:",C0CMAP,! . ;MAPPING FOR TEST REQUEST GOES HERE - . D MAP^GPLXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA - . ;D QOPEN^GPLXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML - . D QUEUE^GPLXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO + . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA + . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML + . 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 @@ -91,25 +92,25 @@ RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; . . . I 'C0CQT W "MAPOBX:",C0CTMAP,! - . . . D MAP^GPLXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP + . . . 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^GPLXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST + . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST . . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY - . . . ;. D CP^GPLXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML - . . . ;E D INSINNER^GPLXPATH("C0CTO","C0CTMP") + . . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML + . . . ;E D INSINNER^C0CXPATH("C0CTO","C0CTMP") . . . ; - . . . ;D PUSHA^GPLXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER - . . ; I 'C0CQT D PARY^GPLXPATH("C0CTO") - . . ;D INSINNER^GPLXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST - . ;D QCLOSE^GPLXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML - . D QUEUE^GPLXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ; + . . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER + . . ; I 'C0CQT D PARY^C0CXPATH("C0CTO") + . . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST + . ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML + . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ; . ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT - . . ;D CP^GPLXPATH(C0CRTMP,"RTN") ; - . ;E D INSINNER^GPLXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST - D QUEUE^GPLXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ; - D BUILD^GPLXPATH("C0CRBLD","RTN") ;RENDER THE XML + . . ;D CP^C0CXPATH(C0CRTMP,"RTN") ; + . ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST + D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ; + D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE Q ; @@ -121,7 +122,7 @@ EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL ; N C0CNSSN ; IS THERE AN SSN FLAG S C0CNSSN=0 - S C0CLB=$NA(^TMP("GPLCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS + S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT . S @C0CLB@(0)=0 @@ -131,7 +132,7 @@ EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL D LIST ; 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^GPLLABS + I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS Q ; GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT @@ -142,10 +143,10 @@ GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT . W "LAB LOOKUP FAILED, NO SSN",! . S C0CNSSN=1 ; SET NO SSN FLAG S C0CSPC="*" ; LOOKING FOR ALL LABS - ;I $D(^TMP("GPLCCR","RPMS")) D ; RUNNING RPMS + ;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 + ;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) ; @@ -157,13 +158,13 @@ GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB ; ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR - I '$D(C0CLB) S C0CLB=$NA(^TMP("GPLCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS + 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("GPLCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE - I ^TMP("GPLCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION + I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE + I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE - S C0CTAB=$NA(^TMP("GPLCCR","LABTBL")) ; BASE OF OBX TABLE + 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 @@ -225,8 +226,8 @@ LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB . I 'C0CQT D ; . . W C0CI," ",C0CTYP,! . ; S C0CI=$O(@C0CHB@(C0CI)) - ;K ^TMP("GPLRIM","VARS",DFN,"RESULTS") - ;M ^TMP("GPLRIM","VARS",DFN,"RESULTS")=@C0CLB + ;K ^TMP("C0CRIM","VARS",DFN,"RESULTS") + ;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB Q LTYP(OSEG,OTYP,OVARA,OC0CQT) ; S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE @@ -250,10 +251,10 @@ LOBX ; ; OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING) N GA,GF,GD - S GA=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1)) + S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1)) S GF="RPMS_CCR_"_DFN_"_"_DT_".xml" - S GD=^TMP("GPLCCR","ODIR") - W $$OUTPUT^GPLXPATH(GA,GF,GD) + S GD=^TMP("C0CCCR","ODIR") + W $$OUTPUT^C0CXPATH(GA,GF,GD) Q ; SETTBL ; @@ -379,8 +380,8 @@ SETTBL ; 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("GPLCCR","LABTBL") - M ^TMP("GPLCCR","LABTBL")=X ; SET VALUES IN LAB TBL - S ^TMP("GPLCCR","LABTBL",0)="V3" + K ^TMP("C0CCCR","LABTBL") + M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL + S ^TMP("C0CCCR","LABTBL",0)="V3" Q ; diff --git a/p/GPLPROBS.m b/p/C0CPROBS.m similarity index 68% rename from p/GPLPROBS.m rename to p/C0CPROBS.m index 6f30bf2..66d1984 100644 --- a/p/GPLPROBS.m +++ b/p/C0CPROBS.m @@ -1,7 +1,8 @@ -GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08 +C0CPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08 ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7 - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -26,11 +27,11 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS - ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT + ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT ; N RPCRSLT,J,K,PTMP,X,VMAP,TBU - S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS")) - S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP")) + S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS")) + S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP")) K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES I '$T(GET^BGOPRB) D ; IF BGOPRB ROUTINE IS MISSING (IE RPMS) . D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC @@ -69,43 +70,43 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE . S ARYTMP=$NA(@TARYTMP@(J)) . ; W "ARYTMP= ",ARYTMP,! . K @ARYTMP - . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ; + . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ; . I J=1 D ; FIRST ONE IS JUST A COPY . . ; W "FIRST ONE",! - . . D CP^GPLXPATH(ARYTMP,OUTXML) + . . D CP^C0CXPATH(ARYTMP,OUTXML) . . ; W "OUTXML ",OUTXML,! . I J>1 D ; AFTER THE FIRST, INSERT INNER XML - . . D INSINNER^GPLXPATH(OUTXML,ARYTMP) - ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*) - ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS + . . D INSINNER^C0CXPATH(OUTXML,ARYTMP) + ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*) + ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS ; ZWR @OUTXML ; $$HTML^DILF( ; GENERATE THE NARITIVE HTML FOR THE CCD I CCD D ; IF THIS IS FOR A CCD - . N HTMP,HOUT,HTMLO,GPLPROBI,ZX - . F GPLPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM - . . S VMAP=$NA(@TVMAP@(GPLPROBI)) + . N HTMP,HOUT,HTMLO,C0CPROBI,ZX + . F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM + . . S VMAP=$NA(@TVMAP@(C0CPROBI)) . . I DEBUG W "VMAP =",VMAP,! - . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE - . . D UNMARK^GPLXPATH("HTMP") ; REMOVE MARKUP - . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT - . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES - . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN - . . I GPLPROBI=1 D ; FIRST ONE IS JUST A COPY - . . . D CP^GPLXPATH("HOUT","HTMLO") - . . I GPLPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML + . . D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE + . . D UNMARK^C0CXPATH("HTMP") ; REMOVE MARKUP + . . ; D PARY^C0CXPATH("HTMP") ; PRINT IT + . . D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES + . . ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN + . . I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY + . . . D CP^C0CXPATH("HOUT","HTMLO") + . . I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML . . . I DEBUG W "DOING INNER",! . . . N HTMLBLD,HTMLTMP - . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1) - . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1) - . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0)) - . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP") - . . . D CP^GPLXPATH("HTMLTMP","HTMLO") - . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//") - . I DEBUG D PARY^GPLXPATH("HTMLO") - . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION + . . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1) + . . . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1) + . . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0)) + . . . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP") + . . . D CP^C0CXPATH("HTMLTMP","HTMLO") + . . . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//") + . I DEBUG D PARY^C0CXPATH("HTMLO") + . D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION N PROBSTMP,I - D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS + D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - . ; STRINGS MARKED AS @@X@@ . W !,"PROBLEMS Missing list: ",! diff --git a/p/GPLRIMA.m b/p/C0CRIMA.m similarity index 88% rename from p/GPLRIMA.m rename to p/C0CRIMA.m index cfe2d31..3ac95ee 100644 --- a/p/GPLRIMA.m +++ b/p/C0CRIMA.m @@ -1,7 +1,8 @@ -GPLRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08 +C0CRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08 ;;0.1;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -38,7 +39,7 @@ GPLRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08 ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS ; TO RESUME AT NEXT PATIENT, USE BEGDFN="" - ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST + ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION ; SEE C0CPARMS FOR SUPPORTED PARAMTERS ; @@ -51,29 +52,29 @@ ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT I RIMDFN="" S RIMDFN=RESUME I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS - . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",! + . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",! I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS - . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR + . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR . W RIMDFN,! . ; . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT . ; - . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS - . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS") - . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0) - . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS - . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS") - . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS - . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP") - . I $D(^TMP("GPLCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D ; ALERTS EXIST + . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS + . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS") + . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("C0CCCR",$J,"PROBVALS",0) + . I $D(^TMP("C0CCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS + . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS") + . I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS + . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP") + . I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D ; ALERTS EXIST . . W "FOUND ALERT VARS",! - . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("GPLCCR",$J,"ALERTS") - . I $D(^TMP("GPLCCR",$J,"RESULTS",0)) D ; RESULTS EXIST + . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS") + . I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D ; RESULTS EXIST . . W "FOUND RESULTS VARS",! - . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("GPLCCR",$J,"RESULTS") - . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING + . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS") + . K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING . ; . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP . ; @@ -97,7 +98,7 @@ ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT . ; AND WE SKIP IT . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN - ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL")) + ; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL")) Q ; SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS @@ -120,7 +121,7 @@ SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS . 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","RIMTBL","MEDSCODE") ;CODES - . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES + . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES I $D(@SBASE@("ALERTS",1)) D ; IF THE PATIENT HAS ALERTS . D APOST("SATTR","RIMTBL","ALERTS") . N ZR,ZI @@ -133,7 +134,7 @@ SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS . N ZR,ZI . S ZR(0)=0 ; INITIALIZE TO NONE . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES - . ; D PARY^GPLXPATH("ZR") ; + . ; D PARY^C0CXPATH("ZR") ; . 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)="RESULTTESTCODINGSYSTEM" D ; LOINC CODE CHECK @@ -143,8 +144,8 @@ SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS Q SATTR ; RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES - K ^TMP("GPLRIM","RESUME") - K ^TMP("GPLRIM") + K ^TMP("C0CRIM","RESUME") + K ^TMP("C0CRIM") Q ; CLIST ; LIST THE CATEGORIES @@ -158,7 +159,7 @@ CLIST ; LIST THE CATEGORIES . W "(",$P(@CLBASE@(CLIDX),"^",1) . W ":",$P(@CLBASE@(CLIDX),"^",2),") " . W CLIDX,! - ; D PARY^GPLXPATH(CLBASE) + ; D PARY^C0CXPATH(CLBASE) Q ; CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES @@ -178,7 +179,7 @@ CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES W "CBASE: ",CCTBL,! ; I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY - . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY + . 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 @@ -239,7 +240,7 @@ XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT S ZI="" F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END . S ZI=$O(@ZPATBASE@(ZI)) - . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE + . D XPAT^C0CCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE Q ; CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT @@ -261,13 +262,13 @@ CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT ; N ATTR S ATTR="" - I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT + I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT - S ATTR=^TMP("GPLRIM","ATTR",DFN) + S ATTR=^TMP("C0CRIM","ATTR",DFN) I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q ;NO ATTRIBUTES FOUND - I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT + I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT . N CAT - . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT + . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT . W CAT,": ",ATTR,! Q ; @@ -287,10 +288,10 @@ APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME) Q ; ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL - I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM")) + I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM")) I '$D(@RIMBASE) S @RIMBASE="" - I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE - S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES + I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE + S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES Q ; AINIT ; INITIALIZE ATTRIBUTE TABLE @@ -362,7 +363,7 @@ PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR ; N ZR D GETPA(.ZR,DFN,ISEC,IVAR) - I $D(ZR(0)) D PARY^GPLXPATH("ZR") + I $D(ZR(0)) D PARY^C0CXPATH("ZR") E W "NOTHING RETURNED",! Q ; @@ -404,7 +405,7 @@ DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR I ZR(0)=0 D Q ; . W "NO PATIENTS RETURNED",! E D ; - . D PARY^GPLXPATH("ZR") ; PRINT ARRAY + . D PARY^C0CXPATH("ZR") ; PRINT ARRAY . W "COUNT=",ZR(0),! Q ; @@ -438,20 +439,20 @@ ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE . . S ZZGN2=$NA(@ZZGN@(ZGVI)) . . W ZZGN2,!,$O(@ZZGN2@("")),! - . . D H2ARY^GPLXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY - . . ; D PARY^GPLXPATH("ZZGA") - . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN + . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY + . . ; D PARY^C0CXPATH("ZZGA") + . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN Q ; -DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM +DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM ; ALONG WITH SAMPLE VALUES. ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER" N GTMP - I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT + I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES I '$D(IWHICH) S IWHICH="ALL" D RPCGV(.GTMP,DFN,IWHICH) - D PARY^GPLXPATH("GTMP") + D PARY^C0CXPATH("GTMP") Q ; RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT @@ -460,7 +461,7 @@ RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT ; I '$D(RWHICH) S RWHICH="ALL" ;N R2TMP - I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT + I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z diff --git a/p/GPLSNOA.m b/p/C0CSNOA.m similarity index 85% rename from p/GPLSNOA.m rename to p/C0CSNOA.m index e2654d3..7c3843b 100644 --- a/p/GPLSNOA.m +++ b/p/C0CSNOA.m @@ -1,7 +1,8 @@ -GPLSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08 +C0CSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08 ;;0.1;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -24,7 +25,7 @@ GPLSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08 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^GPLSNOA TO RESET TO TOP OF DRUG LIST + ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST ; N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR N CCRGLO @@ -35,9 +36,9 @@ ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE 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^GPLSNOA",! + . 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^GPLCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR + . ;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" @@ -58,7 +59,7 @@ ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE . ; . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN - ; D PARY^GPLXPATH(@SNOBASE@("ATTRTBL")) + ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL")) Q ; TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN @@ -69,21 +70,21 @@ TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN Q ; ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL - I '$D(SNOBASE) S SNOBASE=$NA(^TMP("GPLSNO")) + 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("GPLSNO","SNOTBL","TABLE")) ; ATTR TABLE - S ^TMP("GPLSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES + 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^GPLRIMA(SNOTBL,"CODE") - D APUSH^GPLRIMA(SNOTBL,"NOCODE") - D APUSH^GPLRIMA(SNOTBL,"MULTICODE") - D APUSH^GPLRIMA(SNOTBL,"SUBMULTI") - D APUSH^GPLRIMA(SNOTBL,"DONE") + 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 @@ -102,7 +103,7 @@ SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS 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 ; GPL + Q SATTR ; C0C I $D(@SBASE@("PROBLEMS",1)) D ; . D APOST("SATTR","SNOTBL","PROBLEMS") . ; W "POSTING PROBLEMS",! @@ -110,18 +111,18 @@ SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES . D APOST("SATTR","SNOTBL","MEDS") . N ZR,ZI - . D GETPA^GPLRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES + . 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^GPLSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED 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("GPLSNO","RESUME") - K ^TMP("GPLSNO") + K ^TMP("C0CSNO","RESUME") + K ^TMP("C0CSNO") Q ; CLIST ; LIST THE CATEGORIES @@ -135,7 +136,7 @@ CLIST ; LIST THE CATEGORIES . W "(",$P(@CLBASE@(CLIDX),"^",1) . W ":",$P(@CLBASE@(CLIDX),"^",2),") " . W CLIDX,! - ; D PARY^GPLXPATH(CLBASE) + ; D PARY^C0CXPATH(CLBASE) Q ; CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES @@ -155,7 +156,7 @@ CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES ; W "CBASE: ",CCTBL,! ; I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY - . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY + . 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 @@ -174,12 +175,12 @@ CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES ; Q ; -REUSE ; GET SAVED VALUES FROM ^TMP("GPLSAV") AND PUT THEM IN A DATABASE +REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE ; D ASETUP D AINIT N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH - S SAVBASE=$NA(^TMP("GPLSAV","VARS")) + S SAVBASE=$NA(^TMP("C0CSAV","VARS")) S SNOI="" F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST . S SNOI=$O(@SAVBASE@(SNOI)) @@ -194,4 +195,4 @@ REUSE ; GET SAVED VALUES FROM ^TMP("GPLSAV") AND PUT THEM IN A DATABASE . W SNOK,! . W SNOJ,! Q - ; \ No newline at end of file + ; diff --git a/p/GPLUNIT.m b/p/C0CUNIT.m similarity index 94% rename from p/GPLUNIT.m rename to p/C0CUNIT.m index 7f50998..5c513dd 100644 --- a/p/GPLUNIT.m +++ b/p/C0CUNIT.m @@ -1,6 +1,6 @@ -GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08 +C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08 ;;0.1;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU + ;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 @@ -40,7 +40,7 @@ ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array . 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^GPLXPATH(TN,BAT) + . ; D PUSH^C0CXPATH(TN,BAT) S ZARY(0)=CNT ; update the array counter Q ; @@ -77,7 +77,7 @@ ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST ; . W NT,@NT@(0),! ; . F J=1:1:@NT@(0) D ; ; . . W @NT@(J),! - ; . . D ZTEST^GPLUNIT(@ZARY,@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 @@ -117,18 +117,18 @@ TEST ; RUN ALL THE TEST CASES 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^GPLXPATH(RTN,I) + . 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^GPLUNIT("TZTMP",RNM) + D ZLOAD^C0CUNIT("TZTMP",RNM) D GTSTS(.TZTMP,"TSTS") F ZI=1:1:TSTS(0) D ; . S TPASSED=0 S TFAILED=0 - . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI)) + . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI)) . S TOTP=TOTP+TPASSED . S TOTF=TOTF+TFAILED . S $P(TSTS(ZI),"^",2)=TPASSED diff --git a/p/GPLVITAL.m b/p/C0CVITAL.m similarity index 94% rename from p/GPLVITAL.m rename to p/C0CVITAL.m index 78fa2ff..1a03e47 100644 --- a/p/GPLVITAL.m +++ b/p/C0CVITAL.m @@ -1,7 +1,8 @@ -GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08 +C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08 ;;0.1;CCDCCR;;JUL 16,2008; - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -38,8 +39,8 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE . S @VITOUTXML@(0)=0 I $P(VITRSLT(1),U,2)="No vitals found." Q ; QUIT ; ZWR RPCRSLT - S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS")) - S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP")) + S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS")) + S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP")) K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY @@ -172,18 +173,18 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN" . . S VITARYTMP=$NA(@VITTARYTMP@(J)) . . K @VITARYTMP - . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP) + . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP) . . I J=1 D ; FIRST ONE IS JUST A COPY . . . ; W "FIRST ONE",! - . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML) + . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML) . . . I DEBUG W "VITOUTXML ",VITOUTXML,! . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML - . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP) + . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP) ; ZWR ^TMP($J,"VITALS",*) ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS - I DEBUG D PARY^GPLXPATH(VITOUTXML) + I DEBUG D PARY^C0CXPATH(VITOUTXML) N VITTMP,I - D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS + D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ . W "VITALS MISSING ",! . F I=1:1:VITTMP(0) W VITTMP(I),! diff --git a/p/C0CXPAT0.m b/p/C0CXPAT0.m new file mode 100644 index 0000000..2f3f67c --- /dev/null +++ b/p/C0CXPAT0.m @@ -0,0 +1,212 @@ +C0CXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08 + ;;0.2;CCDCCR;nopatch;noreleasedate + ;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 + ; + ;;> + ;;> + ;;>>>K C0C S C0C="" + ;;>>>D PUSH^C0CXPATH("C0C","FIRST") + ;;>>>D PUSH^C0CXPATH("C0C","SECOND") + ;;>>>D PUSH^C0CXPATH("C0C","THIRD") + ;;>>>D PUSH^C0CXPATH("C0C","FOURTH") + ;;>>?C0C(0)=4 + ;;> + ;;>>>K GXML S GXML="" + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","@@DATA1@@") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;> + ;;>>>K GXML S GXML="" + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","DATA1") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","DATA2") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>") + ;;>>>D PUSH^C0CXPATH("GXML","DATA3") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;>>>D PUSH^C0CXPATH("GXML","") + ;;> + ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") + ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT") + ;;>>?C0C(C0C(0))="FOURTH" + ;;>>>D POP^C0CXPATH("C0C",.GX) + ;;>>?GX="FOURTH" + ;;>>?C0C(C0C(0))="THIRD" + ;;>>>D POP^C0CXPATH("C0C",.GX) + ;;>>?GX="THIRD" + ;;>>?C0C(C0C(0))="SECOND" + ;;> + ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") + ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT") + ;;>>>S GX="" + ;;>>>D MKMDX^C0CXPATH("C0C",.GX) + ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" + ;;> + ;;>>?$$XNAME^C0CXPATH("DATA1")="FOURTH" + ;;>>?$$XNAME^C0CXPATH("")="SIXTH" + ;;>>?$$XNAME^C0CXPATH("")="THIRD" + ;;> + ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") + ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INITXML") + ;;>>>D INDEX^C0CXPATH("GXML") + ;;>>?GXML("//FIRST/SECOND")="2^12" + ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" + ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" + ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" + ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8" + ;;>>?GXML("//FIRST/SECOND")="2^12" + ;;>>?GXML("//FIRST")="1^13" + ;;> + ;;>>>D ZTEST^C0CXPATH("INITXML2") + ;;>>>D INDEX^C0CXPATH("GXML") + ;;>>?GXML("//FIRST/SECOND")="2^12" + ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" + ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10" + ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" + ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" + ;;>>?GXML("//FIRST")="1^13" + ;;> + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")" + ;;>>>D MISSING^C0CXPATH("GXML",OUTARY) + ;;>>?@OUTARY@(1)="DATA1" + ;;>>?@OUTARY@(2)="DATA2" + ;;> + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" + ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" + ;;>>>S @MAPARY@("DATA2")="VALUE2" + ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY) + ;;>>?@OUTARY@(6)="VALUE2" + ;;> + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" + ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" + ;;>>>S @MAPARY@("DATA1")="VALUE1" + ;;>>>S @MAPARY@("DATA2")="VALUE2" + ;;>>>S @MAPARY@("DATA3")="VALUE3" + ;;>>>S GXML(4)="@@DATA1@@ AND @@DATA3@@" + ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY) + ;;>>>D PARY^C0CXPATH(OUTARY) + ;;>>?@OUTARY@(4)="VALUE1 AND VALUE3" + ;;> + ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3) + ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5) + ;;>>?$P(BTLIST(2),";",2)=4 + ;;> + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2") + ;;>>>D ZTEST^C0CXPATH("QUEUE") + ;;>>>D BUILD^C0CXPATH("BTLIST","G3") + ;;> + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D CP^C0CXPATH("GXML","G2") + ;;>>?G2(0)=13 + ;;> + ;;>>>K G2,GBL + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QOPEN^C0CXPATH("GBL","GXML") + ;;>>?$P(GBL(1),";",3)=12 + ;;>>>D BUILD^C0CXPATH("GBL","G2") + ;;>>?G2(G2(0))="" + ;;> + ;;>>>K G2,GBL + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QOPEN^C0CXPATH("GBL","GXML","//FIRST/SECOND") + ;;>>?$P(GBL(1),";",3)=11 + ;;>>>D BUILD^C0CXPATH("GBL","G2") + ;;>>?G2(G2(0))="" + ;;> + ;;>>>K G2,GBL + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QCLOSE^C0CXPATH("GBL","GXML") + ;;>>?$P(GBL(1),";",3)=13 + ;;>>>D BUILD^C0CXPATH("GBL","G2") + ;;>>?G2(G2(0))="" + ;;> + ;;>>>K G2,GBL + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QCLOSE^C0CXPATH("GBL","GXML","//FIRST/SECOND/THIRD") + ;;>>?$P(GBL(1),";",3)=13 + ;;>>>D BUILD^C0CXPATH("GBL","G2") + ;;>>?G2(G2(0))="" + ;;>>?G2(1)="" + ;;> + ;;>>>K G2,GBL,G3,G4 + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") + ;;>>>D INSERT^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD") + ;;>>>D INSERT^C0CXPATH("G3","G2","//") + ;;>>?G2(1)=GXML(9) + ;;> + ;;>>>K G2,GBL,G3 + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") + ;;>>>D REPLACE^C0CXPATH("GXML","G2","//FIRST/SECOND") + ;;>>?GXML(2)="" + ;;> + ;;>>>K GXML,G2,GBL,G3 + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2") + ;;>>>D INSINNER^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD") + ;;>>?GXML(10)="" + ;;> + ;;>>>K GXML,G2,GBL,G3 + ;;>>>D ZTEST^C0CXPATH("INITXML") + ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2") + ;;>>>D INSINNER^C0CXPATH("G2","G2") + ;;>>?G2(8)="" + ;;> + ;;>>>K GTMP,GTMP2 + ;;>>>N GTMP,GTMP2 + ;;>>>D PUSH^C0CXPATH("GTMP","A") + ;;>>>D PUSH^C0CXPATH("GTMP2","B") + ;;>>>D PUSH^C0CXPATH("GTMP2","C") + ;;>>>D PUSHA^C0CXPATH("GTMP","GTMP2") + ;;>>?GTMP(3)="C" + ;;>>?GTMP(0)=3 + ;;> + ;;>>>K GTMP,GTMP2 + ;;>>>S GTMP("TEST1")=1 + ;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP") + ;;>>?GTMP2(0)=1 + ;;>>?GTMP2(1)="^TEST1^1" + ;;> + ;;>>>K GTMP,GTMP2 + ;;>>>D PUSH^C0CXPATH("GTMP","@@VAR1@@") + ;;>>>D XVARS^C0CXPATH("GTMP2","GTMP") + ;;>>?GTMP2(1)="^VAR1^1" + ;;> diff --git a/p/GPLXPATH.m b/p/C0CXPATH.m similarity index 93% rename from p/GPLXPATH.m rename to p/C0CXPATH.m index 15cb0b2..eef9c31 100644 --- a/p/GPLXPATH.m +++ b/p/C0CXPATH.m @@ -1,6 +1,6 @@ -GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 +C0CXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ;;0.2;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU + ;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 @@ -88,10 +88,10 @@ INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index ; XML SECTION ; ZXML IS PASSED BY NAME N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND - N GPLSTK ; LEAVE OUT FOR DEBUGGING + N C0CSTK ; LEAVE OUT FOR DEBUGGING I '$D(@ZXML@(0)) D ; NO XML PASSED . W "ERROR IN XML FILE",! - S GPLSTK(0)=0 ; INITIALIZE STACK + S C0CSTK(0)=0 ; INITIALIZE STACK F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY . S LINE=@ZXML@(I) . ;W LINE,! @@ -104,33 +104,33 @@ INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index . . . ; W "FOUND ",LINE,! . . . S FOUND=1 ; SET FOUND FLAG . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME - . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK - . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX + . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK + . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX . . . ; W "MDX=",MDX,! . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST - . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK + . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END . . I LINE?.E1"") D ; BEGINNING OF A SECTION . . . ; W "FOUND ",LINE,! . . . S FOUND=1 ; SET FOUND FLAG . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME - . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK - . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX + . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK + . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX . . . ; W "MDX=",MDX,! . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER @@ -270,11 +270,11 @@ INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),! I '$D(@INSXML@(0)) D ; INSERT INTO AN EMPTY ARRAY - . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT + . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY . I $D(INSXPATH) D ; XPATH PROVIDED . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE - . . I DEBUG D PARY^GPLXPATH("INSBLD") + . . I DEBUG D PARY^C0CXPATH("INSBLD") . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML @@ -283,7 +283,7 @@ INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST - . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE + . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE Q ; INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW @@ -296,7 +296,7 @@ INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW . S UXPATH="//" ; USE ROOT XPATH I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED I '$D(@INNXML@(0)) D ; INNXML IS EMPTY - . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER + . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER . D BUILD("INNBLD",INNXML) I @INNXML@(0)>0 D ; NOT EMPTY . D QOPEN("INNBLD",INNXML,UXPATH) ; @@ -349,7 +349,7 @@ MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY S @OARY@(0)=0 ; INITIALIZED MISSING COUNT F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE - . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY + . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY . . Q Q ; @@ -452,7 +452,7 @@ H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY . . . ; W "HEY",IH3,! . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS . . ; W IH,! - . . ; W "GPLZZ",! + . . ; W "C0CZZ",! . . ; W $NA(@IHASH@(H2I)),! . . Q ; . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I)) @@ -475,31 +475,31 @@ DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE ; N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE - . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP + . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP . S DXUSE="DTMP" ; DXUSE IS NAME E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE - . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP + . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP . S DXUSE="DTMP" ; DXUSE IS NAME E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE D XVARS("DVARS",DXUSE) ; PULL OUT VARS - D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM + D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM Q ; TEST ; Run all the test cases - D TESTALL^GPLUNIT("GPLXPAT0") + D TESTALL^C0CUNIT("C0CXPAT0") Q ; ZTEST(WHICH) ; RUN ONE SET OF TESTS N ZTMP S DEBUG=1 - D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0") - D ZTEST^GPLUNIT(.ZTMP,WHICH) + D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") + D ZTEST^C0CUNIT(.ZTMP,WHICH) Q ; TLIST ; LIST THE TESTS N ZTMP - D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0") - D TLIST^GPLUNIT(.ZTMP) + D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") + D TLIST^C0CUNIT(.ZTMP) Q ; diff --git a/p/GPLCCD.m b/p/GPLCCD.m index 683db30..dc83d7a 100644 --- a/p/GPLCCD.m +++ b/p/GPLCCD.m @@ -1,7 +1,8 @@ -GPLCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08 +C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08 ;;0.1;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;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 @@ -28,14 +29,14 @@ EXPORT ; EXPORT ENTRY POINT FOR CCR Q ; XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE - ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR") + ; 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("GPLCCR",$J,DFN,"CCD",1)) + 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("GPLCCR","ODIR")) + 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/" @@ -43,7 +44,7 @@ XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE S ODIR=DIR I DIR="" S ODIR=@ODIRGLB N ZY - S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR) + S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) W $P(ZY,U,2) Q ; @@ -61,15 +62,15 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 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("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE - I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD - E S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR - S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS + 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("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL - I CCD D LOAD^GPLCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE - E D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE - D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL + 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 @@ -80,27 +81,27 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT ; ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES - D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body") - D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors") - I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures") + 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^GPLXPATH(CCDGLO,ZZX,"ACTT1") - D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT - I DEBUG D PARY^GPLXPATH("ACTT2") - D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX) - I DEBUG D PARY^GPLXPATH(CCDGLO) + 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^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG - D CP^GPLXPATH("ACTT2",CCDGLO) + D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG + D CP^C0CXPATH("ACTT2",CCDGLO) ; - K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT - S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS + 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 @@ -108,7 +109,7 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT . 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^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS + . 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 @@ -117,20 +118,20 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT . W "RUNNING ",CALL,! . X CALL . I @OXML@(0)'=0 D ; THERE IS A RESULT - . . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH + . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH . . I CCD D UNSHAVE("ITMP",OXML) - . . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION + . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION . ; NOW INSERT THE RESULTS IN THE CCR BUFFER - . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body") - . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! + . 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^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST - ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") - ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2") - ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") + ; 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^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS + . 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 @@ -148,9 +149,9 @@ 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^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")") - ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")") - I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")") + D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") + ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMEDS;//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 @@ -158,12 +159,12 @@ SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST W SHXML,! W @SHXML@(1),! - D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED - D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART - D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE - D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST - D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION - D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY + 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 @@ -171,16 +172,16 @@ UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST W SHXML,! W @SHXML@(1),! - D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE - D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST - D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP - D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST - D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION - D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY + 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("GPLCCR",$J,DFN,"HEADER")) + N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) ; K @VMAP S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT") I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS @@ -192,10 +193,10 @@ HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT . 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^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY + . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY N CTMP - D MAP^GPLXPATH(CXML,VMAP,"CTMP") - D CP^GPLXPATH("CTMP",CXML) + D MAP^C0CXPATH(CXML,VMAP,"CTMP") + D CP^C0CXPATH("CTMP",CXML) Q ; ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML @@ -220,52 +221,52 @@ ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML . 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^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY + . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY Q ; TEST ; RUN ALL THE TEST CASES - D TESTALL^GPLUNIT("GPLCCR") + D TESTALL^C0CUNIT("C0CCCR") Q ; ZTEST(WHICH) ; RUN ONE SET OF TESTS N ZTMP - D ZLOAD^GPLUNIT("ZTMP","GPLCCR") - D ZTEST^GPLUNIT(.ZTMP,WHICH) + D ZLOAD^C0CUNIT("ZTMP","C0CCCR") + D ZTEST^C0CUNIT(.ZTMP,WHICH) Q ; TLIST ; LIST THE TESTS N ZTMP - D ZLOAD^GPLUNIT("ZTMP","GPLCCR") - D TLIST^GPLUNIT(.ZTMP) + D ZLOAD^C0CUNIT("ZTMP","C0CCCR") + D TLIST^C0CUNIT(.ZTMP) Q ; ;;> ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","") + ;;>>?@C0C@(@C0C@(0))["" ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","") + ;;>>?@C0C@(@C0C@(0))["" ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") + ;;>>?@C0C@(@C0C@(0))["" ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") - ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST") + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") + ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") ;;> - ;;>>>D ZTEST^GPLCCR("ACTLST") - ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") - ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3") + ;;>>>D ZTEST^C0CCCR("ACTLST") + ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") + ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") ;;>>?G3(G3(0))["" ;;> - ;;>>>D ZTEST^GPLCCR("CCR") - ;;>>>W $$TRIM^GPLXPATH(CCDGLO) + ;;>>>D ZTEST^C0CCCR("CCR") + ;;>>>W $$TRIM^C0CXPATH(CCDGLO) ;;> - ;;>>>K GPL S GPL="" - ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","") - ;;>>?@GPL@(@GPL@(0))["" + ;;>>>K C0C S C0C="" + ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","") + ;;>>?@C0C@(@C0C@(0))["" ;;> diff --git a/p/GPLXPAT0.m b/p/GPLXPAT0.m deleted file mode 100644 index ef16500..0000000 --- a/p/GPLXPAT0.m +++ /dev/null @@ -1,212 +0,0 @@ -GPLXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08 - ;;0.2;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - W "NO ENTRY",! - Q - ; - ;;> - ;;> - ;;>>>K GPL S GPL="" - ;;>>>D PUSH^GPLXPATH("GPL","FIRST") - ;;>>>D PUSH^GPLXPATH("GPL","SECOND") - ;;>>>D PUSH^GPLXPATH("GPL","THIRD") - ;;>>>D PUSH^GPLXPATH("GPL","FOURTH") - ;;>>?GPL(0)=4 - ;;> - ;;>>>K GXML S GXML="" - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","@@DATA1@@") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;> - ;;>>>K GXML S GXML="" - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","DATA1") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","DATA2") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>") - ;;>>>D PUSH^GPLXPATH("GXML","DATA3") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;>>>D PUSH^GPLXPATH("GXML","") - ;;> - ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0") - ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") - ;;>>?GPL(GPL(0))="FOURTH" - ;;>>>D POP^GPLXPATH("GPL",.GX) - ;;>>?GX="FOURTH" - ;;>>?GPL(GPL(0))="THIRD" - ;;>>>D POP^GPLXPATH("GPL",.GX) - ;;>>?GX="THIRD" - ;;>>?GPL(GPL(0))="SECOND" - ;;> - ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0") - ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") - ;;>>>S GX="" - ;;>>>D MKMDX^GPLXPATH("GPL",.GX) - ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" - ;;> - ;;>>?$$XNAME^GPLXPATH("DATA1")="FOURTH" - ;;>>?$$XNAME^GPLXPATH("")="SIXTH" - ;;>>?$$XNAME^GPLXPATH("")="THIRD" - ;;> - ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0") - ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML") - ;;>>>D INDEX^GPLXPATH("GXML") - ;;>>?GXML("//FIRST/SECOND")="2^12" - ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" - ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" - ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" - ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8" - ;;>>?GXML("//FIRST/SECOND")="2^12" - ;;>>?GXML("//FIRST")="1^13" - ;;> - ;;>>>D ZTEST^GPLXPATH("INITXML2") - ;;>>>D INDEX^GPLXPATH("GXML") - ;;>>?GXML("//FIRST/SECOND")="2^12" - ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" - ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10" - ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" - ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" - ;;>>?GXML("//FIRST")="1^13" - ;;> - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")" - ;;>>>D MISSING^GPLXPATH("GXML",OUTARY) - ;;>>?@OUTARY@(1)="DATA1" - ;;>>?@OUTARY@(2)="DATA2" - ;;> - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" - ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" - ;;>>>S @MAPARY@("DATA2")="VALUE2" - ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY) - ;;>>?@OUTARY@(6)="VALUE2" - ;;> - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" - ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" - ;;>>>S @MAPARY@("DATA1")="VALUE1" - ;;>>>S @MAPARY@("DATA2")="VALUE2" - ;;>>>S @MAPARY@("DATA3")="VALUE3" - ;;>>>S GXML(4)="@@DATA1@@ AND @@DATA3@@" - ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY) - ;;>>>D PARY^GPLXPATH(OUTARY) - ;;>>?@OUTARY@(4)="VALUE1 AND VALUE3" - ;;> - ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3) - ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5) - ;;>>?$P(BTLIST(2),";",2)=4 - ;;> - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2") - ;;>>>D ZTEST^GPLXPATH("QUEUE") - ;;>>>D BUILD^GPLXPATH("BTLIST","G3") - ;;> - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D CP^GPLXPATH("GXML","G2") - ;;>>?G2(0)=13 - ;;> - ;;>>>K G2,GBL - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QOPEN^GPLXPATH("GBL","GXML") - ;;>>?$P(GBL(1),";",3)=12 - ;;>>>D BUILD^GPLXPATH("GBL","G2") - ;;>>?G2(G2(0))="" - ;;> - ;;>>>K G2,GBL - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND") - ;;>>?$P(GBL(1),";",3)=11 - ;;>>>D BUILD^GPLXPATH("GBL","G2") - ;;>>?G2(G2(0))="" - ;;> - ;;>>>K G2,GBL - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QCLOSE^GPLXPATH("GBL","GXML") - ;;>>?$P(GBL(1),";",3)=13 - ;;>>>D BUILD^GPLXPATH("GBL","G2") - ;;>>?G2(G2(0))="" - ;;> - ;;>>>K G2,GBL - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD") - ;;>>?$P(GBL(1),";",3)=13 - ;;>>>D BUILD^GPLXPATH("GBL","G2") - ;;>>?G2(G2(0))="" - ;;>>?G2(1)="" - ;;> - ;;>>>K G2,GBL,G3,G4 - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") - ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") - ;;>>>D INSERT^GPLXPATH("G3","G2","//") - ;;>>?G2(1)=GXML(9) - ;;> - ;;>>>K G2,GBL,G3 - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") - ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND") - ;;>>?GXML(2)="" - ;;> - ;;>>>K GXML,G2,GBL,G3 - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") - ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") - ;;>>?GXML(10)="" - ;;> - ;;>>>K GXML,G2,GBL,G3 - ;;>>>D ZTEST^GPLXPATH("INITXML") - ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") - ;;>>>D INSINNER^GPLXPATH("G2","G2") - ;;>>?G2(8)="" - ;;> - ;;>>>K GTMP,GTMP2 - ;;>>>N GTMP,GTMP2 - ;;>>>D PUSH^GPLXPATH("GTMP","A") - ;;>>>D PUSH^GPLXPATH("GTMP2","B") - ;;>>>D PUSH^GPLXPATH("GTMP2","C") - ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2") - ;;>>?GTMP(3)="C" - ;;>>?GTMP(0)=3 - ;;> - ;;>>>K GTMP,GTMP2 - ;;>>>S GTMP("TEST1")=1 - ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP") - ;;>>?GTMP2(0)=1 - ;;>>?GTMP2(1)="^TEST1^1" - ;;> - ;;>>>K GTMP,GTMP2 - ;;>>>D PUSH^GPLXPATH("GTMP","@@VAR1@@") - ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP") - ;;>>?GTMP2(1)="^VAR1^1" - ;;> \ No newline at end of file