name spacing the package to C0C ... removing all GPL references
This commit is contained in:
george
parent
0ce4bf1807
commit
0f6cf98b0a
|
|
@ -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
|
||||
;
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
;
|
||||
|
|
@ -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>"
|
||||
|
||||
|
|
@ -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
|
||||
;
|
||||
|
|
@ -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,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
|
||||
;
|
||||
|
|
@ -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: ",!
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
;
|
||||
;
|
||||
|
|
@ -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
|
||||
|
|
@ -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),!
|
||||
|
|
@ -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>
|
||||
|
|
@ -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
165
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
|
||||
;
|
||||
;;><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
212
p/GPLXPAT0.m
|
|
@ -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>
|
||||
Loading…
Reference in New Issue