- Timestamp:
- Jul 29, 2008, 4:57:24 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLACTORS.m
r75 r78 17 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 20 21 22 23 24 25 26 19 ; 20 ; PROCESS THE ACTORS SECTION OF THE CCR 21 ; 22 ; ===Revision History=== 23 ; 0.1 Initial Writing of Skeleton--GPL 24 ; 0.2 Patient Data Extraction--SMH 25 ; 0.3 Information System Info Extraction--SMH 26 ; 27 27 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE 28 ; IPXML is the Input Actor Template into which we are going to substitute values 29 ; This is straight XML. Values to be substituted are in @@VAL@@ format. 28 ; IPXML is the Input Actor Template into which we substitute values 29 ; This is straight XML. Values to be substituted are in @@VAL@@ format. 30 ; ALST is the actor list global generated by ACTLST^GPLCCR and has format: 31 ; ^TMP(7542,1,"ACTORS",0)=Count 32 ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN" 33 ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM" 30 34 31 ; ALST is the actor list global generated by ACTLST^GPLCCR and is in the following format 32 ; ^TMP(7542,1,"ACTORS",0)=Count 33 ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN" 34 ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM" 35 36 ; AXML is the output arrary, to contain XML. 35 ; AXML is the output arrary, to contain XML. 37 36 38 37 N I,J,AMAP,AOID,ATYP,AIEN … … 90 89 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT 91 90 S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT 92 S @AMAP@("ACTORSSN")=$$SSN^CCRDPT 93 S @AMAP@("ACTORSSNSOURCEID")=AOID 91 S @AMAP@("ACTORSSN")="" 92 S @AMAP@("ACTORSSNTEXT")="" 93 S @AMAP@("ACTORSSNSOURCEID")="" 94 S ZX=$$SSN^CCRDPT 95 I ZX'="" D ; IF THERE IS A SSN IN THE RECORD 96 . S @AMAP@("ACTORSSN")=ZX 97 . S @AMAP@("ACTORSSNTEXT")="SSN" 98 . S @AMAP@("ACTORSSNSOURCEID")=AOID 94 99 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT 95 100 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT … … 98 103 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT 99 104 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT 100 S @AMAP@("ACTORRESTEL")=$$RESTEL^CCRDPT 101 S @AMAP@("ACTORWORKTEL")=$$WORKTEL^CCRDPT 102 S @AMAP@("ACTORCELLTEL")=$$CELLTEL^CCRDPT 105 S @AMAP@("ACTORRESTEL")="" 106 S @AMAP@("ACTORRESTELTEXT")="" 107 S ZX=$$RESTEL^CCRDPT 108 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 109 . S @AMAP@("ACTORRESTEL")=ZX 110 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone" 111 S @AMAP@("ACTORWORKTEL")="" 112 S @AMAP@("ACTORWORKTELTEXT")="" 113 S ZX=$$WORKTEL^CCRDPT 114 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 115 . S @AMAP@("ACTORWORKTEL")=ZX 116 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone" 117 S @AMAP@("ACTORCELLTEL")="" 118 S @AMAP@("ACTORCELLTELTEXT")="" 119 S ZX=$$CELLTEL^CCRDPT 120 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD 121 . S @AMAP@("ACTORCELLTEL")=ZX 122 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone" 103 123 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT 104 124 S @AMAP@("ACTORADDRESSSOURCEID")=AOID 105 125 S @AMAP@("ACTORIEN")=AIEN 106 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX? 126 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX 127 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 107 128 D DESTROY^CCRDPT 108 129 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE … … 130 151 S @AMAP@("ACTORRELATION")="" 131 152 S @AMAP@("ACTORRELATIONSOURCEID")="" 153 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 132 154 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 133 155 Q … … 163 185 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN) 164 186 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN) 165 S @AMAP@("ACTORTELEPHONE")=$$TEL^CCRVA200(AIEN) 166 S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN) 187 S @AMAP@("ACTORTELEPHONE")="" 188 S @AMAP@("ACTORTELEPHONETYPE")="" 189 S ZX=$$TEL^CCRVA200(AIEN) 190 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE 191 . S @AMAP@("ACTORTELEPHONE")=ZX 192 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN) 167 193 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN) 168 194 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1" 195 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 169 196 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 170 197 Q -
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="" -
ccr/trunk/p/GPLCCR0.m
r77 r78 552 552 ;;<IDs> 553 553 ;;<Type> 554 ;;<Text> SSN</Text>554 ;;<Text>@@ACTORSSNTEXT@@</Text> 555 555 ;;</Type> 556 556 ;;<ID>@@ACTORSSN@@</ID> … … 574 574 ;;<Value>@@ACTORRESTEL@@</Value> 575 575 ;;<Type> 576 ;;<Text> Residential Telephone</Text>576 ;;<Text>@@ACTORRESTELTEXT@@</Text> 577 577 ;;</Type> 578 578 ;;</Telephone> … … 580 580 ;;<Value>@@ACTORWORKTEL@@</Value> 581 581 ;;<Type> 582 ;;<Text> Work Telephone</Text>582 ;;<Text>@@ACTORWORKTELTEXT@@</Text> 583 583 ;;</Type> 584 584 ;;</Telephone> … … 586 586 ;;<Value>@@ACTORCELLTEL@@</Value> 587 587 ;;<Type> 588 ;;<Text> Cell phone</Text>588 ;;<Text>@@ACTORCELLTELTEXT@@</Text> 589 589 ;;</Type> 590 590 ;;</Telephone> … … 691 691 ;;<Source> 692 692 ;;<Actor> 693 ;;<ActorID>@@ACTORSOURCEID </ActorID>693 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 694 694 ;;</Actor> 695 695 ;;</Source>
Note:
See TracChangeset
for help on using the changeset viewer.