iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

name spacing the package to C0C ... removing all GPL references

This commit is contained in:
george 2009-03-14 22:23:22 +00:00
parent 0ce4bf1807
commit 0f6cf98b0a
15 changed files with 608 additions and 595 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
p/GPLACTOR.m → p/C0CACTOR.m
View File

@ -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
;

17
p/GPLALERT.m → p/C0CALERT.m
View File

@ -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

9
p/GPLCCD1.m → p/C0CCCD1.m
View File

@ -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
;

137
p/GPLCCR.m → p/C0CCCR.m
View File

@ -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
;
;;><TEST>
;;><PROBLEMS>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
;;>>?@GPL@(@GPL@(0))["</Problems>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
;;>>?@C0C@(@C0C@(0))["</Problems>"
;;><VITALS>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
;;><CCR>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
;;><ACTLST>
;;>>>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")
;;><ACTORS>
;;>>>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))["</Actors>"
;;><TRIM>
;;>>>D ZTEST^GPLCCR("CCR")
;;>>>W $$TRIM^GPLXPATH(CCRGLO)
;;>>>D ZTEST^C0CCCR("CCR")
;;>>>W $$TRIM^C0CXPATH(CCRGLO)
;;><ALERTS>
;;>>>S TESTALERT=1
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
;;>>?@GPL@(@GPL@(0))["</Alerts>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
;;>>?@C0C@(@C0C@(0))["</Alerts>"

25
p/GPLIMMU.m → p/C0CIMMU.m
View File

@ -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
. 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
@ -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
;

93
p/GPLLABS.m → p/C0CLABS.m
View File

@ -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) ;<Results>
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
. 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 <Test>
. 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 <Test>
. 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 <Test>
. . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
. . . D QUEUE^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) ;</Result>
. . . ;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) ;</Result>
. ;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)) ;</Results>
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)) ;</Results>
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,7 +143,7 @@ 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
@ -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
;

63
p/GPLPROBS.m → p/C0CPROBS.m
View File

@ -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 <PROBLEMS-HTML> 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 <PROBLEMS-HTML> 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: ",!

85
p/GPLRIMA.m → p/C0CRIMA.m
View File

@ -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

49
p/GPLSNOA.m → p/C0CSNOA.m
View File

@ -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))

14
p/GPLUNIT.m → p/C0CUNIT.m
View File

@ -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

21
p/GPLVITAL.m → p/C0CVITAL.m
View File

@ -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),!

212
p/C0CXPAT0.m Normal file
View File

@ -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
;
;;><TEST>
;;><INIT>
;;>>>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
;;><INITXML>
;;>>>K GXML S GXML=""
;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
;;>>>D PUSH^C0CXPATH("GXML","<FIFTH>")
;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@")
;;>>>D PUSH^C0CXPATH("GXML","</FIFTH>")
;;>>>D PUSH^C0CXPATH("GXML","<SIXTH ID=""SELF"" />")
;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
;;><INITXML2>
;;>>>K GXML S GXML=""
;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA1</FOURTH>")
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>")
;;>>>D PUSH^C0CXPATH("GXML","DATA2")
;;>>>D PUSH^C0CXPATH("GXML","</FOURTH>")
;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA3</FOURTH>")
;;>>>D PUSH^C0CXPATH("GXML","</_SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
;;><PUSHPOP>
;;>>>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"
;;><MKMDX>
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
;;>>>S GX=""
;;>>>D MKMDX^C0CXPATH("C0C",.GX)
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
;;><XNAME>
;;>>?$$XNAME^C0CXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
;;>>?$$XNAME^C0CXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
;;>>?$$XNAME^C0CXPATH("</THIRD>")="THIRD"
;;><INDEX>
;;>>>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"
;;><INDEX2>
;;>>>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"
;;><MISSING>
;;>>>D ZTEST^C0CXPATH("INITXML")
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
;;>>>D MISSING^C0CXPATH("GXML",OUTARY)
;;>>?@OUTARY@(1)="DATA1"
;;>>?@OUTARY@(2)="DATA2"
;;><MAP>
;;>>>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"
;;><MAP2>
;;>>>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)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
;;>>>D PARY^C0CXPATH(OUTARY)
;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
;;><QUEUE>
;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3)
;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5)
;;>>?$P(BTLIST(2),";",2)=4
;;><BUILD>
;;>>>D ZTEST^C0CXPATH("INITXML")
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
;;>>>D ZTEST^C0CXPATH("QUEUE")
;;>>>D BUILD^C0CXPATH("BTLIST","G3")
;;><CP>
;;>>>D ZTEST^C0CXPATH("INITXML")
;;>>>D CP^C0CXPATH("GXML","G2")
;;>>?G2(0)=13
;;><QOPEN>
;;>>>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))="</SECOND>"
;;><QOPEN2>
;;>>>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))="</SECOND>"
;;><QCLOSE>
;;>>>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))="</FIRST>"
;;><QCLOSE2>
;;>>>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))="</FIRST>"
;;>>?G2(1)="</THIRD>"
;;><INSERT>
;;>>>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)
;;><REPLACE>
;;>>>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)="<FIFTH>"
;;><INSINNER>
;;>>>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)="<FIFTH>"
;;><INSINNER2>
;;>>>K GXML,G2,GBL,G3
;;>>>D ZTEST^C0CXPATH("INITXML")
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
;;>>>D INSINNER^C0CXPATH("G2","G2")
;;>>?G2(8)="<FIFTH>"
;;><PUSHA>
;;>>>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
;;><H2ARY>
;;>>>K GTMP,GTMP2
;;>>>S GTMP("TEST1")=1
;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP")
;;>>?GTMP2(0)=1
;;>>?GTMP2(1)="^TEST1^1"
;;><XVARS>
;;>>>K GTMP,GTMP2
;;>>>D PUSH^C0CXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
;;>>>D XVARS^C0CXPATH("GTMP2","GTMP")
;;>>?GTMP2(1)="^VAR1^1"
;;></TEST>

52
p/GPLXPATH.m → p/C0CXPATH.m
View File

@ -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"</"1.E D ; LINE CONTAINS END OF A SECTION
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
. . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
. . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
. . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
. . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
. . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
. . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
. . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
. . . . Q
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
. . I (LINE?.E1"<"1.E)&(LINE'["?>") 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
;

165
p/GPLCCD.m
View File

@ -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
;
;;><TEST>
;;><PROBLEMS>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
;;>>?@GPL@(@GPL@(0))["</Problems>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
;;>>?@C0C@(@C0C@(0))["</Problems>"
;;><VITALS>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
;;><CCR>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
;;><ACTLST>
;;>>>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")
;;><ACTORS>
;;>>>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))["</Actors>"
;;><TRIM>
;;>>>D ZTEST^GPLCCR("CCR")
;;>>>W $$TRIM^GPLXPATH(CCDGLO)
;;>>>D ZTEST^C0CCCR("CCR")
;;>>>W $$TRIM^C0CXPATH(CCDGLO)
;;><CCD>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
;;>>>K C0C S C0C=""
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
;;></TEST>

212
p/GPLXPAT0.m
View File

@ -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
;
;;><TEST>
;;><INIT>
;;>>>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
;;><INITXML>
;;>>>K GXML S GXML=""
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
;;><INITXML2>
;;>>>K GXML S GXML=""
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","DATA2")
;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
;;><PUSHPOP>
;;>>>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"
;;><MKMDX>
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
;;>>>S GX=""
;;>>>D MKMDX^GPLXPATH("GPL",.GX)
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
;;><XNAME>
;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
;;><INDEX>
;;>>>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"
;;><INDEX2>
;;>>>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"
;;><MISSING>
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
;;>>?@OUTARY@(1)="DATA1"
;;>>?@OUTARY@(2)="DATA2"
;;><MAP>
;;>>>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"
;;><MAP2>
;;>>>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)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
;;>>>D PARY^GPLXPATH(OUTARY)
;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
;;><QUEUE>
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
;;>>?$P(BTLIST(2),";",2)=4
;;><BUILD>
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
;;>>>D ZTEST^GPLXPATH("QUEUE")
;;>>>D BUILD^GPLXPATH("BTLIST","G3")
;;><CP>
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D CP^GPLXPATH("GXML","G2")
;;>>?G2(0)=13
;;><QOPEN>
;;>>>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))="</SECOND>"
;;><QOPEN2>
;;>>>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))="</SECOND>"
;;><QCLOSE>
;;>>>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))="</FIRST>"
;;><QCLOSE2>
;;>>>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))="</FIRST>"
;;>>?G2(1)="</THIRD>"
;;><INSERT>
;;>>>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)
;;><REPLACE>
;;>>>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)="<FIFTH>"
;;><INSINNER>
;;>>>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)="<FIFTH>"
;;><INSINNER2>
;;>>>K GXML,G2,GBL,G3
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
;;>>>D INSINNER^GPLXPATH("G2","G2")
;;>>?G2(8)="<FIFTH>"
;;><PUSHA>
;;>>>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
;;><H2ARY>
;;>>>K GTMP,GTMP2
;;>>>S GTMP("TEST1")=1
;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
;;>>?GTMP2(0)=1
;;>>?GTMP2(1)="^TEST1^1"
;;><XVARS>
;;>>>K GTMP,GTMP2
;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
;;>>?GTMP2(1)="^VAR1^1"
;;></TEST>