Enabled Vitals processing in GPLCCR.m

Fixed bug where if you ran EXPORT^GPLCCR more than once body tags would still get added (added  K ^TMP($J,"CCRSTEP") before setting it 	by INITSTPS)
Added code to start processing Vitals for selected patient
Cleaned up some of the template CCR so information in CCR would be correct
This commit is contained in:
cje 2008-07-02 16:34:15 +00:00
parent a26fb0b883
commit f6fe8898bf
4 changed files with 1343 additions and 1307 deletions

View File

@ -1,146 +1,148 @@
GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
;;0.1;CCDCCR;nopatch;noreleasedate ;;0.1;CCDCCR;nopatch;noreleasedate
; ;
; EXPORT A CCR ; EXPORT A CCR
; ;
EXPORT ; EXPORT ENTRY POINT FOR CCR EXPORT ; EXPORT ENTRY POINT FOR CCR
; Select a patient. ; Select a patient.
S DIC=2,DIC(0)="AEMQ" D ^DIC S DIC=2,DIC(0)="AEMQ" D ^DIC
I Y<1 Q ; EXIT I Y<1 Q ; EXIT
S DFN=$P(Y,U,1) ; SET THE PATIENT S DFN=$P(Y,U,1) ; SET THE PATIENT
N CCRGLO N CCRGLO
D CCRRPC(.CCRGLO,DFN,"CCR","","","") D CCRRPC(.CCRGLO,DFN,"CCR","","","")
S OARY=$NA(^TMP($J,DFN,"CCR",1)) S OARY=$NA(^TMP($J,DFN,"CCR",1))
S ONAM="PAT_"_DFN_"_CCR_V1.xml" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
S ODIR="/home/glilly/CCROUT" S ODIR="/home/glilly/CCROUT"
D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) ;S ODIR="/home/cedwards/"
Q D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
; Q
CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT ;
; CCRGRTN IS RETURN ARRAY PASSED BY NAME CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT
; DFN IS PATIENT IEN ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE ; DFN IS PATIENT IEN
; CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL ; CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES
S DEBUG=1 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE S DEBUG=0
S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR
S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR
D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
; D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL ;
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
; I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES ;
; D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS ;
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
. D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
. S IXML="INXML" . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
. ; W OXML,! . S IXML="INXML"
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
. W "RUNNING ",CALL,! . ; W OXML,!
. X CALL . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER . W "RUNNING ",CALL,!
. D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") . X CALL
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
Q . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
; D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS Q
; TAB IS PASSED BY NAME ;
; W "TAB= ",TAB,! INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
; D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") ; TAB IS PASSED BY NAME
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") ; W "TAB= ",TAB,!
Q D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
; D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT Q
N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) ;
; K @VMAP HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN ; K @VMAP
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ??? I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
. S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES, . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY
I IHDR'="" D ; HEADER VALUES ARE PROVIDED . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES,
. D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
N CTMP I IHDR'="" D ; HEADER VALUES ARE PROVIDED
D MAP^GPLXPATH(CXML,VMAP,"CTMP") . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
D CP^GPLXPATH("CTMP",CXML) N CTMP
Q D MAP^GPLXPATH(CXML,VMAP,"CTMP")
; D CP^GPLXPATH("CTMP",CXML)
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML Q
; AXML AND ACTRTN ARE PASSED BY NAME ;
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
; P1= OBJECTID - ACTORPATIENT_2 ; AXML AND ACTRTN ARE PASSED BY NAME
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
; OR PERSON(IN PATIENT FILE IE NOK) ; P1= OBJECTID - ACTORPATIENT_2
; P3= IEN RECORD NUMBER FOR ACTOR - 2 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION
N I,J,K,L ; OR PERSON(IN PATIENT FILE IE NOK)
K @ACTRTN ; CLEAR RETURN ARRAY ; P3= IEN RECORD NUMBER FOR ACTOR - 2
F I=1:1:@AXML@(0) D ; SCAN ALL LINES N I,J,K,L
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR ON THIS LINE K @ACTRTN ; CLEAR RETURN ARRAY
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) F I=1:1:@AXML@(0) D ; SCAN ALL LINES
. . W "<ActorID>=>",J,! . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR ON THIS LINE
. . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
S I="" ; GOING TO $O THROUGH THE HASH . . ;W "<ActorID>=>",J,!
F J=0:0 D Q:$O(K(I))="" . . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS S I="" ; GOING TO $O THROUGH THE HASH
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID F J=0:0 D Q:$O(K(I))=""
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
. D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER
Q . 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
TEST ; RUN ALL THE TEST CASES Q
;D TESTALL^GPLUNIT("GPLCCR") ;
D ZTEST^GPLCCR("PROBLEMS") TEST ; RUN ALL THE TEST CASES
W "TESTING RETURNED FROM PROBLMES",! ;D TESTALL^GPLUNIT("GPLCCR")
D ZTEST^GPLCCR("CCR") D ZTEST^GPLCCR("PROBLEMS")
Q W "TESTING RETURNED FROM PROBLMES",!
; D ZTEST^GPLCCR("CCR")
ZTEST(WHICH) ; RUN ONE SET OF TESTS Q
N ZTMP ;
D ZLOAD^GPLUNIT("ZTMP","GPLCCR") ZTEST(WHICH) ; RUN ONE SET OF TESTS
D ZTEST^GPLUNIT(.ZTMP,WHICH) N ZTMP
Q D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
; D ZTEST^GPLUNIT(.ZTMP,WHICH)
TLIST ; LIST THE TESTS Q
N ZTMP ;
D ZLOAD^GPLUNIT("ZTMP","GPLCCR") TLIST ; LIST THE TESTS
D TLIST^GPLUNIT(.ZTMP) N ZTMP
Q D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
; D TLIST^GPLUNIT(.ZTMP)
;;><TEST> Q
;;><PROBLEMS> ;
;;>>>K GPL S GPL="" ;;><TEST>
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") ;;><PROBLEMS>
;;>>?@GPL@(@GPL@(0))="</Problems>" ;;>>>K GPL S GPL=""
;;><CCR> ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
;;>>>D ^%ZTER ;;>>?@GPL@(@GPL@(0))="</Problems>"
;;>>>K GPL S GPL="" ;;><CCR>
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") ;;>>>D ^%ZTER
;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>" ;;>>>K GPL S GPL=""
;;><ACTLST> ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;>>>N TCCR ;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>"
;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","") ;;><ACTLST>
;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST") ;;>>>N TCCR
;;></TEST> ;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","")
;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST")
;;></TEST>

File diff suppressed because it is too large Load Diff

View File

@ -1,15 +1,49 @@
GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08 GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08
;;0.1;CCDCCR;nopatch;noreleasedate ;;0.1;CCDCCR;nopatch;noreleasedate
EXTRACT(VITXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
; ;
; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
; ;
N VITALSTMP,I N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
S VITALSTMP="^TMP($J,""MISSINGVITALS"")" D VITALS^ORQQVI(.VITRSLT,DFN,"","")
; ZWR @VITXML I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q
D MISSING^GPLXPATH(VITXML,VITALSTMP) ; SEARCH XML FOR MISSING VARS ;ZWR RPCRSLT
I @VITALSTMP@(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ S VITTVMAP=$NA(^TMP($J,"VITALS"))
. W "VITALS MISSING ",! S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP"))
. F I=1:1:@VITALSTMP@(0) W @VITALSTMP@(I),! F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST
Q . I $D(VITRSLT(J)) D
. . S VITVMAP=$NA(@VITTVMAP@(J))
. . K @VITVMAP
. . I DEBUG W "VMAP= ",VMAP,!
. . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
. . S @VITVMAP@("DATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
. . I $P(VITPTMP,U,2)="HT" D
. . . S @VITVMAP@("HEIGHTWEIGHTDATATIME")=$P(VITPTMP,U,4)
. . . S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
. . . S @VITVMAP@("HEIGHTSOURCEID")=$P(VITPTMP,U,1)
. . . S @VITVMAP@("HEIGHTINCHES")=$P(VITPTMP,U,3)
. . I $P(VITPTMP,U,2)="WT" D
. . . S @VITVMAP@("WEIGHTSOURCEID")=$P(VITPTMP,U,1)
. . . S @VITVMAP@("WEIGHTLBS")=$P(VITPTMP,U,3)
. . S VITARYTMP=$NA(@VITTARYTMP@(J))
. . K @VITARYTMP
. . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
. . I J=1 D ; FIRST ONE IS JUST A COPY
. . . ; W "FIRST ONE",!
. . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
. . . ; W "OUTXML ",OUTXML,!
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
. . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
;ZWR ^TMP($J,"VITALS",*)
;ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
; W "OUT OF FOR LOOP.",!
;ZWR
; ZWR @OUTXML
; $$HTML^DILF(
N VITTMP,I
D MISSING^GPLXPATH(VITXML,"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),!
Q

File diff suppressed because it is too large Load Diff