Changeset 78 for ccr/trunk/p/GPLCCD.m
- Timestamp:
- Jul 29, 2008, 4:57:24 PM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLCCD.m
r76 r78 25 25 I Y<1 Q ; EXIT 26 26 S DFN=$P(Y,U,1) ; SET THE PATIENT 27 ; N CC RGLO28 D CCDRPC(.CC RGLO,DFN,"CCD","","","")27 ; N CCDGLO 28 D CCDRPC(.CCDGLO,DFN,"CCD","","","") 29 29 S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1)) 30 30 S ONAM="PAT_"_DFN_"_CCD_V1.xml" … … 53 53 I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD 54 54 S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 55 I CCD S CC RGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD56 E S CC RGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR55 I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD 56 E S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 57 57 S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 58 58 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC … … 60 60 I CCD D LOAD^GPLCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE 61 61 E D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 62 D CP^GPLXPATH(TGLOBAL,CC RGLO) ; COPY THE TEMPLATE TO CCR GLOBAL62 D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 63 63 N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES 64 64 S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT 65 65 S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD 66 S @CC RGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT67 S @TGLOBAL@(3)=@CC RGLO@(3) ; CAP THE TEMPLATE TOO68 S @CC RGLO@(@CCRGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP66 S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT 67 S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO 68 S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP 69 69 S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP 70 70 ; 71 71 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 72 72 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 73 D REPLACE^GPLXPATH(CC RGLO,"","//ContinuityOfCareRecord/Body")74 D REPLACE^GPLXPATH(CC RGLO,"","//ContinuityOfCareRecord/Actors")75 I 'CCD D REPLACE^GPLXPATH(CC RGLO,"","//ContinuityOfCareRecord/Signatures")76 I DEBUG F I=1:1:@CC RGLO@(0) W @CCRGLO@(I),!77 ; 78 I 'CCD D HDRMAP(CC RGLO,DFN,HDRARY) ; MAP HEADER VARIABLES73 D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body") 74 D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors") 75 I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures") 76 I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),! 77 ; 78 I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 79 79 ; MAPPING THE PATIENT PORTION OF THE CDA HEADER 80 80 S ZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient" 81 D QUERY^GPLXPATH(CC RGLO,ZX,"ACTT1")81 D QUERY^GPLXPATH(CCDGLO,ZX,"ACTT1") 82 82 D PATIENT^GPLACTORS("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT 83 83 I DEBUG D PARY^GPLXPATH("ACTT2") 84 D REPLACE^GPLXPATH(CC RGLO,"ACTT2",ZX)85 I DEBUG D PARY^GPLXPATH(CC RGLO)84 D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZX) 85 I DEBUG D PARY^GPLXPATH(CCDGLO) 86 86 K ACTT1 K ACCT2 87 87 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER 88 88 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION 89 D ORG^GPLACTORS(CC RGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG90 D CP^GPLXPATH("ACTT2",CC RGLO)89 D ORG^GPLACTORS(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG 90 D CP^GPLXPATH("ACTT2",CCDGLO) 91 91 ; 92 92 K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT … … 111 111 . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION 112 112 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 113 . D INSERT^GPLXPATH(CC RGLO,OXML,"//ContinuityOfCareRecord/Body")113 . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body") 114 114 . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! 115 115 ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE 116 ; D ACTLST^GPLCCR(CC RGLO,ACTGLO) ; GEN THE ACTOR LIST116 ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST 117 117 ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 118 118 ; D EXTRACT^GPLACTORS("ACTT",ACTGLO,"ACTT2") 119 ; D INSINNER^GPLXPATH(CC RGLO,"ACTT2","//ContinuityOfCareRecord/Actors")119 ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 120 120 N I,J,DONE S DONE=0 121 121 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 122 . S J=$$TRIM^GPLXPATH(CC RGLO) ; DELETE EMPTY ELEMENTS122 . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS 123 123 . W "TRIMMED",J,! 124 124 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 125 125 I CCD D ; TURN THE BODY INTO A CCD COMPONENT 126 126 . N I 127 . F I=1:1:@CC RGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY128 . . I @CC RGLO@(I)["<Body>" D ; REPLACE BODY MARKUP129 . . . S @CC RGLO@(I)="<component><structuredBody>" ; WITH CCD EQ130 . . I @CC RGLO@(I)["</Body>" D ; REPLACE BODY MARKUP131 . . . S @CC RGLO@(I)="</structuredBody></component>"132 S @CC RGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD133 S @CC RGLO@(@CCRGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE127 . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY 128 . . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP 129 . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ 130 . . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP 131 . . . S @CCDGLO@(I)="</structuredBody></component>" 132 S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD 133 S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE 134 134 Q 135 135 ; … … 253 253 ;;><TRIM> 254 254 ;;>>>D ZTEST^GPLCCR("CCR") 255 ;;>>>W $$TRIM^GPLXPATH(CC RGLO)255 ;;>>>W $$TRIM^GPLXPATH(CCDGLO) 256 256 ;;><CCD> 257 257 ;;>>>K GPL S GPL=""
Note:
See TracChangeset
for help on using the changeset viewer.