second CCD commit

This commit is contained in:
george 2008-07-26 19:16:58 +00:00
parent b21dd6e6ec
commit 45cb9f3225
4 changed files with 69 additions and 62 deletions

View File

@ -49,23 +49,23 @@ EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
. W AOID_" "_ATYP_" "_AIEN,!
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
. . D PATIENT("ATMP",@ALST@(I),"ATMP2")
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
. ;
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
. . D SYSTEM("ATMP",@ALST@(I),"ATMP2")
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
. ;
. I ATYP="NOK" D ; NOK ACTOR TYPE
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
. . D NOK("ATMP",@ALST@(I),"ATMP2")
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
. ;
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
. . D PROVIDER("ATMP",@ALST@(I),"ATMP2")
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
. ;
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
. . D ORG("ATMP",@ALST@(I),"ATMP2")
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
. ;
. D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
;
@ -76,11 +76,12 @@ EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
Q
;
PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
;
W "PROCESSING ACTOR PATIENT ",ACTREC,!
W "PROCESSING ACTOR PATIENT ",AIEN,!
; N AMAP
S AMAP=$NA(^TMP($J,"AMAP"))
K @AMAP
D INIT^CCRDPT(AIEN)
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
@ -101,14 +102,17 @@ PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
S @AMAP@("ACTORCELLTEL")=$$CELLTEL^CCRDPT
S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
S @AMAP@("ACTORIEN")=AIEN
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX?
D DESTROY^CCRDPT
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
Q
;
SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
;
; N AMAP
S AMAP=$NA(^TMP($J,"AMAP"))
K @AMAP
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
@ -116,10 +120,11 @@ SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
Q
;
NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
;
; N AMAP
S AMAP=$NA(^TMP($J,"AMAP"))
K @AMAP
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
S @AMAP@("ACTORDISPLAYNAME")=""
S @AMAP@("ACTORRELATION")=""
@ -127,20 +132,22 @@ NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
Q
;
ORG(INXML,ACTREC,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
;
; N AMAP
S AMAP=$NA(^TMP($J,"AMAP"))
K @AMAP
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
Q
;
PROVIDER(INXML,ACTREC,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
;
; N AMAP
S AMAP=$NA(^TMP($J,"AMAP"))
K @AMAP
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)

View File

@ -25,7 +25,7 @@ EXPORT ; EXPORT ENTRY POINT FOR CCR
I Y<1 Q ; EXIT
S DFN=$P(Y,U,1) ; SET THE PATIENT
; N CCRGLO
D CCRRPC(.CCRGLO,DFN,"CCD","","","")
D CCDRPC(.CCRGLO,DFN,"CCD","","","")
S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
S ONAM="PAT_"_DFN_"_CCD_V1.xml"
S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
@ -37,7 +37,7 @@ EXPORT ; EXPORT ENTRY POINT FOR CCR
D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
Q
;
CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
; DFN IS PATIENT IEN
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
@ -47,7 +47,7 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
; - NULL MEANS NOW
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
; "TO" VARIABLES
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
S DEBUG=0
N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
@ -60,6 +60,7 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
I CCD D LOAD^GPLCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE
E D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
S @CCRGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
@ -74,7 +75,19 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
I 'CCD D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
;
D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
I 'CCD D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
; MAPPING THE PATIENT PORTION OF THE CDA HEADER
S ZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
D QUERY^GPLXPATH(CCRGLO,ZX,"ACTT1")
D PATIENT^GPLACTORS("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
D PARY^GPLXPATH("ACTT2")
D REPLACE^GPLXPATH(CCRGLO,"ACTT2",ZX)
D PARY^GPLXPATH(CCRGLO)
K ACTT1 K ACCT2
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
D ORG^GPLACTORS(CCRGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
D CP^GPLXPATH("ACTT2",CCRGLO)
;
K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
@ -98,10 +111,11 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
. D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
D EXTRACT^GPLACTORS("ACTT",ACTGLO,"ACTT2")
D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
; D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
; D EXTRACT^GPLACTORS("ACTT",ACTGLO,"ACTT2")
; D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
N I,J,DONE S DONE=0
F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
. S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS

View File

@ -94,25 +94,25 @@ MARKUP ;<MARKUP>
;;<templateId root="2.16.840.1.113883.10.20.1"/>
;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
;;<title>Good Health Clinic Continuity of Care Document</title>
;;<title>Continuity of Care Document</title>
;;<effectiveTime value="20000407130000+0500"/>
;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
;;<languageCode code="en-US"/>
;;<recordTarget>
;;<patientRole>
;;<id extension="996-756-495" root="2.16.840.1.113883.19.5"/>
;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
;;<patient>
;;<name>
;;<given>Henry</given>
;;<family>Levin</family>
;;<suffix>the 7th</suffix>
;;<given>@@ACTORGIVENNAME@@</given>
;;<family>@@ACTORFAMILYNAME@@</family>
;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
;;</name>
;;<administrativeGenderCode code="M" codeSystem="2.16.840.1.113883.5.1"/>
;;<birthTime value="19320924"/>
;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
;;</patient>
;;<providerOrganization>
;;<id root="2.16.840.1.113883.19.5"/>
;;<name>Good Health Clinic</name>
;;<name>@@ORGANIZATIONNAME@@</name>
;;</providerOrganization>
;;</patientRole>
;;</recordTarget>
@ -122,14 +122,14 @@ MARKUP ;<MARKUP>
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
;;<assignedPerson>
;;<name>
;;<prefix>Dr.</prefix>
;;<given>Robert</given>
;;<family>Dolin</family>
;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
;;<given>@@ACTORGIVENNAME@@</given>
;;<family>@@ACTORFAMILYNAME@@</family>
;;</name>
;;</assignedPerson>
;;<representedOrganization>
;;<id root="2.16.840.1.113883.19.5"/>
;;<name>Good Health Clinic</name>
;;<name>@@ORGANIZATIONNAME@@</name>
;;</representedOrganization>
;;</assignedAuthor>
;;</author>
@ -138,7 +138,7 @@ MARKUP ;<MARKUP>
;;<id nullFlavor="NI"/>
;;<representedOrganization>
;;<id root="2.16.840.1.113883.19.5"/>
;;<name>Good Health Clinic</name>
;;<name>@@ORGANIZATIONNAME@@</name>
;;</representedOrganization>
;;</assignedEntity>
;;</informant>
@ -146,7 +146,7 @@ MARKUP ;<MARKUP>
;;<assignedCustodian>
;;<representedCustodianOrganization>
;;<id root="2.16.840.1.113883.19.5"/>
;;<name>Good Health Clinic</name>
;;<name>@@ORGANIZATIONNAME@@</name>
;;</representedCustodianOrganization>
;;</assignedCustodian>
;;</custodian>
@ -157,29 +157,12 @@ MARKUP ;<MARKUP>
;;<id nullFlavor="NI"/>
;;<representedOrganization>
;;<id root="2.16.840.1.113883.19.5"/>
;;<name>Good Health Clinic</name>
;;<name>@@ORGANIZATIONNAME@@</name>
;;</representedOrganization>
;;</assignedEntity>
;;</legalAuthenticator>
;;<Actors>
;;<participant typeCode="IND">
;;<associatedEntity classCode="GUAR">
;;<id root="4ff51570-83a9-47b7-91f2-93ba30373141"/>
;;<addr>
;;<streetAddressLine>17 Daws Rd.</streetAddressLine>
;;<city>Blue Bell</city>
;;<state>MA</state>
;;<postalCode>02368</postalCode>
;;</addr>
;;<telecom value="tel:(888)555-1212"/>
;;<associatedPerson>
;;<name>
;;<given>Kenneth</given>
;;<family>Ross</family>
;;</name>
;;</associatedPerson>
;;</associatedEntity>
;;</participant>
;;<ACTOR-NOK>
;;<participant typeCode="IND">
;;<associatedEntity classCode="NOK">
;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
@ -193,12 +176,12 @@ MARKUP ;<MARKUP>
;;</associatedPerson>
;;</associatedEntity>
;;</participant>
;;</ACTOR-NOK>
;;</Actors>
;;<documentationOf>
;;<serviceEvent classCode="PCPR">
;;<effectiveTime>
;;<low value="19320924"/>
;;<high value="20000407"/>
;;<high value="@@DATETIME@@"/>
;;</effectiveTime>
;;<performer typeCode="PRF">
;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
@ -210,14 +193,14 @@ MARKUP ;<MARKUP>
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
;;<assignedPerson>
;;<name>
;;<prefix>Dr.</prefix>
;;<given>Robert</given>
;;<family>Dolin</family>
;;<prefix>@@ACTORPREFIXNAME@@</prefix>
;;<given>@@ACTORGIVENNAME@@</given>
;;<family>@@ACTORFAMILYNAME@@</family>
;;</name>
;;</assignedPerson>
;;<representedOrganization>
;;<id root="2.16.840.1.113883.19.5"/>
;;<name>Good Health Clinic</name>
;;<name>@@ORGANIZATIONNAME@@</name>
;;</representedOrganization>
;;</assignedEntity>
;;</performer>

View File

@ -308,11 +308,14 @@ REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
S XFIRST=$P(XNODE,"^",1)
S XLAST=$P(XNODE,"^",2)
D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
. D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
. D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
I RENEW'="" D ; NEW XML IS NOT NULL
. D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
. D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
I DEBUG W "REPALCE PREBUILD",!
. D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
I DEBUG W "REPLACE PREBUILD",!
I DEBUG D PARY("REBLD")
D BUILD("REBLD","RTMP")
K @REXML ; KILL WHAT WAS THERE
@ -360,7 +363,7 @@ MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
. . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
. . . W "IN MAPPING LOOP: ",TSTR,!
. . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
. . . S TVAL="" ; DEFAULT FOR UNMAPPED VARIABLES
. . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
. . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
. . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
. . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER