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

more extraneous write cleanup

This commit is contained in:
george 2008-09-03 23:54:55 +00:00
parent eb1b732387
commit c779e0dc5b
5 changed files with 12 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
p/GPLACTOR.m
View File

@ -36,7 +36,7 @@ EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
N I,J,AMAP,AOID,ATYP,AIEN N I,J,AMAP,AOID,ATYP,AIEN
D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
W "PROCESSING ACTORS ",! I DEBUG W "PROCESSING ACTORS ",!
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
@ -44,7 +44,7 @@ EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
. I ATYP="" Q ; NOT A VALID ACTOR . I ATYP="" Q ; NOT A VALID ACTOR
. ; . ;
. W AOID_" "_ATYP_" "_AIEN,! . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2") . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
@ -77,7 +77,7 @@ EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
; ;
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
; ;
W "PROCESSING ACTOR PATIENT ",AIEN,! I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
N AMAP,ZX N AMAP,ZX
S AMAP=$NA(^TMP($J,"AMAP")) S AMAP=$NA(^TMP($J,"AMAP"))
K @AMAP K @AMAP

8
p/GPLCCR.m
View File

@ -93,7 +93,7 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
. ; K @OXML ; KILL EXPECTED OUTPUT ARRAY . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
. ; W OXML,! . ; W OXML,!
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
. W "RUNNING ",CALL,! . I DEBUG W "RUNNING ",CALL,!
. X CALL . X CALL
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
. I @OXML@(0)'=0 D ; THERE IS A RESULT . I @OXML@(0)'=0 D ; THERE IS A RESULT
@ -106,13 +106,13 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
N TRIMI,J,DONE S DONE=0 N TRIMI,J,DONE S DONE=0
F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 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^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
. W "TRIMMED",J,! . I DEBUG W "TRIMMED",J,!
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
Q Q
; ;
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
; TAB IS PASSED BY NAME ; TAB IS PASSED BY NAME
W "TAB= ",TAB,! I DEBUG W "TAB= ",TAB,!
; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS ; 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;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")") D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
@ -152,7 +152,7 @@ ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
F I=1:1:@AXML@(0) D ; SCAN ALL LINES F I=1:1:@AXML@(0) D ; SCAN ALL LINES
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR 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) . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
. . W "<ActorID>=>",J,! . . I DEBUG W "<ActorID>=>",J,!
. . I J'="" S K(J)="" ; HASHING ACTOR . . I J'="" S K(J)="" ; HASHING ACTOR
. . ; TO GET RID OF DUPLICATES . . ; TO GET RID OF DUPLICATES
S I="" ; GOING TO $O THROUGH THE HASH S I="" ; GOING TO $O THROUGH THE HASH

1
p/GPLMEDS.m
View File

@ -83,7 +83,6 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2) . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
. I ZK>2 D ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS . I ZK>2 D ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
. . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
. . S ZN=0 ; DON'T KNOW WHY
. . F ZN=2:1:ZK-1 D ; REMAINING LINES IN EACH MED . . F ZN=2:1:ZK-1 D ; REMAINING LINES IN EACH MED
. . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D ; REMOVE THIS MARKUP . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D ; REMOVE THIS MARKUP
. . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT

8
p/GPLPROBS.m
View File

@ -41,7 +41,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
. S VMAP=$NA(@TVMAP@(J)) . S VMAP=$NA(@TVMAP@(J))
. K @VMAP . K @VMAP
. W "VMAP= ",VMAP,! . I DEBUG W "VMAP= ",VMAP,!
. S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1) . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
@ -81,7 +81,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
. N HTMP,HOUT,HTMLO,GPLPROBI,ZX . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
. F GPLPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM . F GPLPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
. . S VMAP=$NA(@TVMAP@(GPLPROBI)) . . S VMAP=$NA(@TVMAP@(GPLPROBI))
. . W "VMAP =",VMAP,! . . I DEBUG W "VMAP =",VMAP,!
. . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
. . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
. . ; D PARY^GPLXPATH("HTMP") ; PRINT IT . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
@ -90,7 +90,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
. . I GPLPROBI=1 D ; FIRST ONE IS JUST A COPY . . I GPLPROBI=1 D ; FIRST ONE IS JUST A COPY
. . . D CP^GPLXPATH("HOUT","HTMLO") . . . D CP^GPLXPATH("HOUT","HTMLO")
. . I GPLPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML . . I GPLPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML
. . . W "DOING INNER",! . . . I DEBUG W "DOING INNER",!
. . . N HTMLBLD,HTMLTMP . . . N HTMLBLD,HTMLTMP
. . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1) . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
. . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1) . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
@ -104,7 +104,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
. ; STRINGS MARKED AS @@X@@ . ; STRINGS MARKED AS @@X@@
. W "PROBLEMS Missing list: ",! . W !,"PROBLEMS Missing list: ",!
. F I=1:1:PROBSTMP(0) W PROBSTMP(I),! . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
Q Q
; ;

2
p/GPLVITAL.m
View File

@ -170,7 +170,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . I J=1 D ; FIRST ONE IS JUST A COPY . . I J=1 D ; FIRST ONE IS JUST A COPY
. . . ; W "FIRST ONE",! . . . ; W "FIRST ONE",!
. . . D CP^GPLXPATH(VITARYTMP,VITOUTXML) . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
. . . W "VITOUTXML ",VITOUTXML,! . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
. . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP) . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
; ZWR ^TMP($J,"VITALS",*) ; ZWR ^TMP($J,"VITALS",*)