Index: /ccr/trunk/p/GPLACTORS.m
===================================================================
--- /ccr/trunk/p/GPLACTORS.m (revision 74)
+++ /ccr/trunk/p/GPLACTORS.m (revision 75)
@@ -50,21 +50,21 @@
. 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
@@ -77,9 +77,10 @@
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
@@ -102,12 +103,15 @@
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
@@ -117,8 +121,9 @@
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")=""
@@ -128,8 +133,9 @@
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)
@@ -138,8 +144,9 @@
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)
Index: /ccr/trunk/p/GPLCCD.m
===================================================================
--- /ccr/trunk/p/GPLCCD.m (revision 74)
+++ /ccr/trunk/p/GPLCCD.m (revision 75)
@@ -26,5 +26,5 @@
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"
@@ -38,5 +38,5 @@
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
@@ -48,5 +48,5 @@
; 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
@@ -61,4 +61,5 @@
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
@@ -75,5 +76,17 @@
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
@@ -99,8 +112,9 @@
. 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
Index: /ccr/trunk/p/GPLCCD1.m
===================================================================
--- /ccr/trunk/p/GPLCCD1.m (revision 74)
+++ /ccr/trunk/p/GPLCCD1.m (revision 75)
@@ -95,5 +95,5 @@
;;
;;