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

Minor code cleanup -- some test case bugs fixed

This commit is contained in:
george 2008-06-26 17:51:24 +00:00
parent 555f3ac4f3
commit c473eb8bf4
5 changed files with 78 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
p/GPLCCR.m
View File

@ -47,16 +47,16 @@ CCRRPC(CCRGRTN,DFN,CCRPART) ; RPC ENTRY POINT FOR CCR OUTPUT
. W "RUNNING ",CALL,!
. X CALL
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
. ; D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
. D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
. D QOPEN^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body")
. D QUEUE^GPLXPATH("CCRBLD",OXML,1,@OXML@(0))
. D QCLOSE^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body")
. I DEBUG W "GOING TO BUILD CCR",!
. N CCRTMP
. D BUILD^GPLXPATH("CCRBLD","CCRTMP")
. I DEBUG F GPLI=1:1:CCRTMP(0) W CCRTMP(GPLI),!
. D CP^GPLXPATH("CCRTMP",CCRGLO)
. ; D QOPEN^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body")
. ; D QUEUE^GPLXPATH("CCRBLD",OXML,1,@OXML@(0))
. ; D QCLOSE^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body")
. ; I DEBUG W "GOING TO BUILD CCR",!
. ; N CCRTMP
. ; D BUILD^GPLXPATH("CCRBLD","CCRTMP")
. ; I DEBUG F GPLI=1:1:CCRTMP(0) W CCRTMP(GPLI),!
. ; D CP^GPLXPATH("CCRTMP",CCRGLO)
Q
;
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS

4
p/GPLCCR0.m
View File

@ -90,8 +90,8 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Text>@@PROBLEMDESCRIPTION@@</Text>
;;<Code>
;;<Value>@@PROBLEMCODEVALUE@@</Value>
;;<CodingSystem>@@PROBLEMCODINGSYSTEM@@ICD9CM</CodingSystem>
;;<Version>@@PROBLEMCODINGVERSION@@2007</Version>
;;<CodingSystem>ICD9CM</CodingSystem>
;;<Version>@@PROBLEMCODINGVERSION@@</Version>
;;</Code>
;;</Description>
;;<Source>

2
p/GPLPROBS.m
View File

@ -14,7 +14,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
N RPCRSLT,J,K,PTMP,X,VMAP,TBUF
D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
I '$D(RPCRSLT(0)) W "ERROR CALLING LIST^ORQQPL3 ",! Q
I DEBUG ZWR RPCRSLT
ZWR RPCRSLT
S TVMAP=$NA(^TMP($J,"PROBVALS"))
S TARYTMP=$NA(^TMP($J,"PROBARYTMP"))
F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST

72
p/GPLUNIT.m
View File

@ -16,12 +16,14 @@ ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
S CNT=CNT+1 ; increment count
S ZARY(CNT)=TST ; put the test in the array
I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
. N II ; TEMP FOR ENDING TEST IN BATTERY
. N II,TN ; TEMP FOR ENDING TEST IN BATTERY
. S II=$P(ZARY(BAT),"^",2)
. S $P(ZARY(BAT),"^",2)=II+1
I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
. S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
. S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
. ; S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
. S TN=$NA(ZARY("TESTS"))
. D PUSH^GPLXPATH(TN,BAT)
S ZARY(0)=CNT ; update the array counter
Q
;
@ -45,38 +47,46 @@ ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
. . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
. . I LINE?." "1";;>>".E D ; test case found
. . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
; S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
Q
;
ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST
N I,ZX,ZR,ZP
S DEBUG=0
I '$D(ZARY(WHICH)) D ; TEST SECTION DOESN'T EXIST
. W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
. Q ; EXIT
N FIRST,LAST
S FIRST=$P(ZARY(WHICH),"^",1)
S LAST=$P(ZARY(WHICH),"^",2)
F I=FIRST:1:LAST D
. I ZARY(I)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
. . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
. . ; W ZP,!
. . S ZX=ZP
. . W "RUNNING: "_ZP
. . X ZX
. . W "..SUCCESS: ",WHICH,!
. I ZARY(I)?1"?"1.E D ; THIS IS A TEST
. . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
. . S ZX="S ZR="_ZP
. . W "TRYING: "_ZP
. . X ZX
. . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
. . I '$D(TPASSED) D ; NOT INITIALIZED YET
. . . S TPASSED=0 S TFAILED=0
. . I ZR S TPASSED=TPASSED+1
. . I 'ZR S TFAILED=TFAILED+1
Q
;
N I,ZX,ZR,ZP
S DEBUG=0
I WHICH="ALL" D Q ; RUN ALL THE TESTS
. W "DOING ALL",!
. N J,NT
. S NT=$NA(ZARY("TESTS"))
. W NT,@NT@(0),!
. F J=1:1:@NT@(0) D ;
. . W @NT@(J),!
. . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
I '$D(ZARY(WHICH)) D ; TEST SECTION DOESN'T EXIST
. W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
. Q ; EXIT
N FIRST,LAST
S FIRST=$P(ZARY(WHICH),"^",1)
S LAST=$P(ZARY(WHICH),"^",2)
F I=FIRST:1:LAST D
. I ZARY(I)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
. . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
. . ; W ZP,!
. . S ZX=ZP
. . W "RUNNING: "_ZP
. . X ZX
. . W "..SUCCESS: ",WHICH,!
. I ZARY(I)?1"?"1.E D ; THIS IS A TEST
. . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
. . S ZX="S ZR="_ZP
. . W "TRYING: "_ZP
. . X ZX
. . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
. . I '$D(TPASSED) D ; NOT INITIALIZED YET
. . . S TPASSED=0 S TFAILED=0
. . I ZR S TPASSED=TPASSED+1
. . I 'ZR S TFAILED=TFAILED+1
Q
;
TEST ; RUN ALL THE TEST CASES
N ZTMP
D ZLOAD(.ZTMP)

50
p/GPLXPATH.m
View File

@ -188,6 +188,7 @@ 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
D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
D BUILD("CPINSTR",CPDEST)
Q
@ -237,14 +238,12 @@ INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
; XML AT THE END OF THE XPATH POINT
; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
; N INSBLD,INSTMP
N INSBLD,INSTMP
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
. W "DOING A BAD COPY",!
. D CP^GPLXPATH(INSNEW,INXML) ; JUST COPY INTO THE OUTPUT
I '$D(@INSXML@(0)) D Q ; INSERT INTO AN EMPTY ARRAY
. D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
. W "GOT HERE",!
. I $D(INSXPATH) D ; XPATH PROVIDED
. . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
. . I DEBUG ZWR INSBLD
@ -255,8 +254,8 @@ INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
. . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
. 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 BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
. D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
Q
;
INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
@ -334,22 +333,23 @@ PARY(GLO) ;PRINT AN ARRAY
Q
;
TEST ; RUN ALL THE TEST CASES
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,"ALL")
W "PASSED: ",TPASSED,!
W "FAILED: ",TFAILED,!
W !
; W "THE TESTS!",!
; ZWR ZTMP
Q
;
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,"ALL")
W "PASSED: ",TPASSED,!
W "FAILED: ",TFAILED,!
W !
; W "THE TESTS!",!
; ZWR ZTMP
Q
;
ZTEST(WHICH) ; RUN ONE SET OF TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,WHICH)
Q
;
N ZTMP
S DEBUG=1
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,WHICH)
Q
;
TLIST ; LIST THE TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
@ -493,9 +493,9 @@ TLIST ; LIST THE TESTS
;;>>>K G2,GBL,G3,G4
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
;;>>>D INSERT^GPLXPATH("GXML","G2","G3","//FIRST/SECOND/THIRD")
;;>>>D INSERT^GPLXPATH("G3","G2","G4","//FIRST/SECOND/THIRD")
;;>>?G2(1)=G3(9)
;;>>>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")