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