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

first version with Procedures

This commit is contained in:
george 2010-01-22 07:45:25 +00:00
parent 660c736f20
commit 740660128e
3 changed files with 55 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
p/C0CCCR.m
View File

@ -148,6 +148,7 @@ INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
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,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
Q
;
HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT

22
p/C0CPROC.m
View File

@ -61,6 +61,7 @@ TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
. . . S ZRNF("PROCCODESYS")="CPT-4"
. . . S ZRNF("PROCDATETEXT")="Procedure Date"
. . . S ZRNF("PROCDATETIME")=ZDATE
. . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
. . . S ZRNF("PROCDESCOBJATTR")=""
. . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
. . . S ZRNF("PROCDESCOBJATTRVAL")=""
@ -70,6 +71,9 @@ TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
. . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI
. . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
. . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
. . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
M @ZRIM=@C0CPRC@("V")
Q
;
PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
@ -96,5 +100,23 @@ CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
;
MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML
;
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
K @ZTEMP
N ZBLD
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
N ZINNER
D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
N ZTMP,ZVAR,ZI
S ZI=""
F S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI="" D ;FOR EACH PROCEDURE
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
. S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
N ZZTMP
D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
K @ZTEMP,@ZBLD
Q
;

32
p/C0CRNF.m
View File

@ -43,6 +43,38 @@ FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
. S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
Q
;
TESTRNF ; TEST THE RNF1TO2 ROUTINE
S G1("ONE")=1
S G1("TWO")=2
S G1("THREE")=3
D RNF1TO2("GPL","G1")
S G1("ONE")="NOT1"
S G1("TWO")="STILL2"
S G1("THREE")=3
D RNF1TO2("GPL","G1")
ZWR GPL
Q
;
RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
; (ZOUT) BOTH ARE PASSED BY NAME
; RNF1 IS OF THE FORM:
; @ZIN@("VAR1")=VAL1
; @ZIN@("VAR2")=VAL2
; RNF2 IS OF THE FORM:
; @ZOUT@("F","VAR1")=""
; @ZOUT@("F","VAR2")=""
; @ZOUT@("V",n,"VAR1")=VAL1
; @ZOUT@("V",n,"VAR2")=VAL2
; WHERE n IS THE "ROW" OF THE ARRAY
N ZI S ZI=""
N ZN
I '$D(@ZOUT@("V",1)) S ZN=1
E S ZN=$O(@ZOUT@("V",""),-1)+1
F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
. S @ZOUT@("F",ZI)=""
. S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
Q
;
GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
; GRTN IS PASSED BY NAME
;