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

fixed CCR unit test cases - TEST^GPLCCR for all

This commit is contained in:
george 2008-07-03 14:37:05 +00:00
parent f6fe8898bf
commit e2223f14aa
2 changed files with 674 additions and 669 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
p/GPLCCR.m
View File

@ -20,23 +20,25 @@ EXPORT ; EXPORT ENTRY POINT FOR CCR
CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
; DFN IS PATIENT IEN
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE
; CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
; - NULL MEANS NOW
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
; "TO" VARIABLES
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
S DEBUG=0
S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR
S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR
S CCRGRTN=$NA(^TMP($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 THE CCR GLOBAL
D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO 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 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")
@ -45,7 +47,7 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT
D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
;
K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS
S CCRXTAB="^TMP($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
@ -79,7 +81,7 @@ HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
. S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY
. S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES,
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
@ -93,30 +95,29 @@ ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
; AXML AND ACTRTN ARE PASSED BY NAME
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
; P1= OBJECTID - ACTORPATIENT_2
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
; OR INSTITUTION
; OR PERSON(IN PATIENT FILE IE NOK)
; P3= IEN RECORD NUMBER FOR ACTOR - 2
N I,J,K,L
K @ACTRTN ; CLEAR RETURN ARRAY
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR ON THIS LINE
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
. . ;W "<ActorID>=>",J,!
. . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES
. . W "<ActorID>=>",J,!
. . I J'="" S K(J)="" ; HASHING ACTOR
. . ; TO GET RID OF DUPLICATES
S I="" ; GOING TO $O THROUGH THE HASH
F J=0:0 D Q:$O(K(I))=""
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER
. 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
Q
;
TEST ; RUN ALL THE TEST CASES
;D TESTALL^GPLUNIT("GPLCCR")
D ZTEST^GPLCCR("PROBLEMS")
W "TESTING RETURNED FROM PROBLMES",!
D ZTEST^GPLCCR("CCR")
D TESTALL^GPLUNIT("GPLCCR")
Q
;
ZTEST(WHICH) ; RUN ONE SET OF TESTS
@ -135,14 +136,17 @@ TLIST ; LIST THE TESTS
;;><PROBLEMS>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
;;>>?@GPL@(@GPL@(0))="</Problems>"
;;>>?@GPL@(@GPL@(0))["</Problems>"
;;><VITALS>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
;;><CCR>
;;>>>D ^%ZTER
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>"
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
;;><ACTLST>
;;>>>N TCCR
;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","")
;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST")
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
;;></TEST>

21
p/GPLXPATH.m
View File

@ -73,7 +73,8 @@ INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
. I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
. I FOUND'=1 D
. . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
. . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE
. . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
. . . ; ON THE SAME LINE
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
@ -82,10 +83,10 @@ INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH 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, IS NOT A MULTIPLE
. . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST LINE
. . . 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
. I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC
. 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
@ -96,7 +97,7 @@ INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
. . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
. . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
. . . . Q
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION
. 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
@ -106,7 +107,7 @@ INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH 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, IS NOT A MULTIPLE
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
. . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
S @ZXML@("INDEXED")=""
S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
@ -188,14 +189,14 @@ CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
I @CPSRC@(0)<1 D ; BAD LENGTH
. W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
. Q
; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE
; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
D BUILD("CPINSTR",CPDEST)
Q
;
QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT
; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
; USED TO INSERT CHILDREN NODES
I @QOXML@(0)<1 D ; MALFORMED XML
. W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
@ -268,7 +269,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 XML
. D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
. D BUILD("INNBLD",INNXML)
I @INNXML@(0)>0 D ; NOT EMPTY
. D QOPEN("INNBLD",INNXML,UXPATH) ;
@ -323,7 +324,7 @@ MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY
. . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME
. . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
. . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
. . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT
. . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3)
W "MAPPED",!
Q
;