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