Changeset 36 for ccr/trunk/p/GPLCCR.m
- Timestamp:
- Jul 3, 2008, 4:54:25 PM (16 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/GPLCCR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLCCR.m
r35 r36 1 GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 ; 4 ; EXPORT A CCR 5 ; 6 EXPORT ; EXPORT ENTRY POINT FOR CCR 7 ; Select a patient. 8 S DIC=2,DIC(0)="AEMQ" D ^DIC 9 I Y<1 Q ; EXIT 10 S DFN=$P(Y,U,1) ; SET THE PATIENT 11 N CCRGLO 12 D CCRRPC(.CCRGLO,DFN,"CCR","","","") 13 S OARY=$NA(^TMP($J,DFN,"CCR",1)) 14 S ONAM="PAT_"_DFN_"_CCR_V1.xml" 15 S ODIR="/home/glilly/CCROUT" 16 ;S ODIR="/home/cedwards/" 17 D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) 18 Q 19 ; 20 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 21 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 22 ; DFN IS PATIENT IEN 23 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 24 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 25 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 26 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME 27 ; - NULL MEANS NOW 28 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND 29 ; "TO" VARIABLES 30 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN 31 S DEBUG=0 32 S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 33 S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 34 S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS 35 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 36 S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 37 D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 38 D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 39 ; 40 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 41 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 42 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 43 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 44 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 45 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 46 ; 47 D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 48 ; 49 K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 50 S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR STEPS 51 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 52 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 53 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 54 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE 55 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 56 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 57 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 58 . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 59 . S IXML="INXML" 60 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 61 . ; W OXML,! 62 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 63 . W "RUNNING ",CALL,! 64 . X CALL 65 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 66 . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 67 . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! 68 D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 69 Q 70 ; 71 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 72 ; TAB IS PASSED BY NAME 73 ; W "TAB= ",TAB,! 74 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") 75 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") 76 Q 77 ; 78 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 79 N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) 80 ; K @VMAP 81 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 82 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 83 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ??? 84 . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY 85 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES, 86 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 87 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 88 . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 89 N CTMP 90 D MAP^GPLXPATH(CXML,VMAP,"CTMP") 91 D CP^GPLXPATH("CTMP",CXML) 92 Q 93 ; 94 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 95 ; AXML AND ACTRTN ARE PASSED BY NAME 96 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 97 ; P1= OBJECTID - ACTORPATIENT_2 98 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 99 ; OR INSTITUTION 100 ; OR PERSON(IN PATIENT FILE IE NOK) 101 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 102 N I,J,K,L 103 K @ACTRTN ; CLEAR RETURN ARRAY 104 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 105 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 106 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 107 . . W "<ActorID>=>",J,! 108 . . I J'="" S K(J)="" ; HASHING ACTOR 109 . . ; TO GET RID OF DUPLICATES 110 S I="" ; GOING TO $O THROUGH THE HASH 111 F J=0:0 D Q:$O(K(I))="" 112 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 113 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 114 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 115 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 116 . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 117 Q 118 ; 119 TEST ; RUN ALL THE TEST CASES 120 D TESTALL^GPLUNIT("GPLCCR") 121 Q 122 ; 123 ZTEST(WHICH) ; RUN ONE SET OF TESTS 124 N ZTMP 125 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 126 D ZTEST^GPLUNIT(.ZTMP,WHICH) 127 Q 128 ; 129 TLIST ; LIST THE TESTS 130 N ZTMP 131 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 132 D TLIST^GPLUNIT(.ZTMP) 133 Q 134 ; 135 ;;><TEST> 136 ;;><PROBLEMS> 137 ;;>>>K GPL S GPL="" 138 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") 139 ;;>>?@GPL@(@GPL@(0))["</Problems>" 140 ;;><VITALS> 141 ;;>>>K GPL S GPL="" 142 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","") 143 ;;>>?@GPL@(@GPL@(0))["</VitalSigns>" 144 ;;><CCR> 145 ;;>>>K GPL S GPL="" 146 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") 147 ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>" 148 ;;><ACTLST> 149 ;;>>>K GPL S GPL="" 150 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") 151 ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST") 152 ;;></TEST> 1 GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 ; 4 ; EXPORT A CCR 5 ; 6 EXPORT ; EXPORT ENTRY POINT FOR CCR 7 ; Select a patient. 8 S DIC=2,DIC(0)="AEMQ" D ^DIC 9 I Y<1 Q ; EXIT 10 S DFN=$P(Y,U,1) ; SET THE PATIENT 11 N CCRGLO 12 D CCRRPC(.CCRGLO,DFN,"CCR","","","") 13 S OARY=$NA(^TMP($J,DFN,"CCR",1)) 14 S ONAM="PAT_"_DFN_"_CCR_V1.xml" 15 S ODIR="/home/glilly/CCROUT" 16 ;S ODIR="/home/cedwards/" 17 D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) 18 Q 19 ; 20 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 21 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 22 ; DFN IS PATIENT IEN 23 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 24 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 25 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 26 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME 27 ; - NULL MEANS NOW 28 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND 29 ; "TO" VARIABLES 30 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN 31 S DEBUG=0 32 S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 33 S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 34 S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS 35 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 36 S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 37 D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 38 D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 39 ; 40 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 41 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 42 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 43 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 44 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 45 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 46 ; 47 D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 48 ; 49 K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 50 S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR STEPS 51 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 52 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 53 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 54 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE 55 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 56 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 57 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 58 . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 59 . S IXML="INXML" 60 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 61 . ; W OXML,! 62 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 63 . W "RUNNING ",CALL,! 64 . X CALL 65 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 66 . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 67 . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! 68 D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 69 Q 70 ; 71 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 72 ; TAB IS PASSED BY NAME 73 ; W "TAB= ",TAB,! 74 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") 75 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") 76 Q 77 ; 78 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 79 N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) 80 ; K @VMAP 81 S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$FMTHL7^XLFDT($$NOW^XLFDT),"DT") 82 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 83 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 84 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ??? 85 . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY 86 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES, 87 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 88 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 89 . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 90 N CTMP 91 D MAP^GPLXPATH(CXML,VMAP,"CTMP") 92 D CP^GPLXPATH("CTMP",CXML) 93 Q 94 ; 95 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 96 ; AXML AND ACTRTN ARE PASSED BY NAME 97 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 98 ; P1= OBJECTID - ACTORPATIENT_2 99 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 100 ; OR INSTITUTION 101 ; OR PERSON(IN PATIENT FILE IE NOK) 102 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 103 N I,J,K,L 104 K @ACTRTN ; CLEAR RETURN ARRAY 105 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 106 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 107 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 108 . . W "<ActorID>=>",J,! 109 . . I J'="" S K(J)="" ; HASHING ACTOR 110 . . ; TO GET RID OF DUPLICATES 111 S I="" ; GOING TO $O THROUGH THE HASH 112 F J=0:0 D Q:$O(K(I))="" 113 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 114 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 115 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 116 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 117 . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 118 Q 119 ; 120 TEST ; RUN ALL THE TEST CASES 121 D TESTALL^GPLUNIT("GPLCCR") 122 Q 123 ; 124 ZTEST(WHICH) ; RUN ONE SET OF TESTS 125 N ZTMP 126 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 127 D ZTEST^GPLUNIT(.ZTMP,WHICH) 128 Q 129 ; 130 TLIST ; LIST THE TESTS 131 N ZTMP 132 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 133 D TLIST^GPLUNIT(.ZTMP) 134 Q 135 ; 136 ;;><TEST> 137 ;;><PROBLEMS> 138 ;;>>>K GPL S GPL="" 139 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") 140 ;;>>?@GPL@(@GPL@(0))["</Problems>" 141 ;;><VITALS> 142 ;;>>>K GPL S GPL="" 143 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","") 144 ;;>>?@GPL@(@GPL@(0))["</VitalSigns>" 145 ;;><CCR> 146 ;;>>>K GPL S GPL="" 147 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") 148 ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>" 149 ;;><ACTLST> 150 ;;>>>K GPL S GPL="" 151 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") 152 ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST") 153 ;;></TEST>
Note:
See TracChangeset
for help on using the changeset viewer.
