198 lines
7.7 KiB
Mathematica
198 lines
7.7 KiB
Mathematica
GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
|
;;0.4;CCDCCR;nopatch;noreleasedate
|
|
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|
; General Public License See attached copy of the License.
|
|
;
|
|
; This program is free software; you can redistribute it and/or modify
|
|
; it under the terms of the GNU General Public License as published by
|
|
; the Free Software Foundation; either version 2 of the License, or
|
|
; (at your option) any later version.
|
|
;
|
|
; This program is distributed in the hope that it will be useful,
|
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
; GNU General Public License for more details.
|
|
;
|
|
; You should have received a copy of the GNU General Public License along
|
|
; with this program; if not, write to the Free Software Foundation, Inc.,
|
|
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
;
|
|
; PROCESS THE ACTORS SECTION OF THE CCR
|
|
;
|
|
; ===Revision History===
|
|
; 0.1 Initial Writing of Skeleton--GPL
|
|
; 0.2 Patient Data Extraction--SMH
|
|
; 0.3 Information System Info Extraction--SMH
|
|
; 0.4 Patient data rouine refactored; adjustments here--SMH
|
|
;
|
|
EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
|
; IPXML is the Input Actor Template into which we substitute values
|
|
; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
|
; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
|
|
; ^TMP(7542,1,"ACTORS",0)=Count
|
|
; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
|
; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
|
; AXML is the output arrary, to contain XML.
|
|
;
|
|
N I,J,AMAP,AOID,ATYP,AIEN
|
|
D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
|
D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
|
I DEBUG W "PROCESSING ACTORS ",!
|
|
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
|
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
|
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
|
. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
|
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
|
. I ATYP="" Q ; NOT A VALID ACTOR
|
|
. ;
|
|
. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
|
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
|
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
|
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
|
. ;
|
|
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
|
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
|
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
|
. ;
|
|
. I ATYP="NOK" D ; NOK ACTOR TYPE
|
|
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
|
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
|
. ;
|
|
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
|
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
|
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
|
. ;
|
|
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
|
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
|
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
|
. ;
|
|
. D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
|
. K ATYP,AIEN,AOID ; BE SURE TO GET THE NEXT ONE
|
|
;
|
|
N ACTTMP
|
|
D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
|
I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
|
. ; STRINGS MARKED AS @@X@@
|
|
. W "ACTORS Missing list: ",!
|
|
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
|
Q
|
|
;
|
|
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
|
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
|
N AMAP,ZX
|
|
S AMAP=$NA(^TMP($J,"AMAP"))
|
|
K @AMAP
|
|
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORSSN")=""
|
|
S @AMAP@("ACTORSSNTEXT")=""
|
|
S @AMAP@("ACTORSSNSOURCEID")=""
|
|
S ZX=$$SSN^CCRDPT(AIEN)
|
|
I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
|
. S @AMAP@("ACTORSSN")=ZX
|
|
. S @AMAP@("ACTORSSNTEXT")="SSN"
|
|
. S @AMAP@("ACTORSSNSOURCEID")=AOID
|
|
S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORRESTEL")=""
|
|
S @AMAP@("ACTORRESTELTEXT")=""
|
|
S ZX=$$RESTEL^CCRDPT(AIEN)
|
|
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
|
. S @AMAP@("ACTORRESTEL")=ZX
|
|
. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
|
S @AMAP@("ACTORWORKTEL")=""
|
|
S @AMAP@("ACTORWORKTELTEXT")=""
|
|
S ZX=$$WORKTEL^CCRDPT(AIEN)
|
|
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
|
. S @AMAP@("ACTORWORKTEL")=ZX
|
|
. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
|
S @AMAP@("ACTORCELLTEL")=""
|
|
S @AMAP@("ACTORCELLTELTEXT")=""
|
|
S ZX=$$CELLTEL^CCRDPT(AIEN)
|
|
I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
|
. S @AMAP@("ACTORCELLTEL")=ZX
|
|
. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
|
S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
|
|
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
|
S @AMAP@("ACTORIEN")=AIEN
|
|
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
|
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
|
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|
Q
|
|
;
|
|
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
|
|
S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
|
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|
Q
|
|
;
|
|
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")=""
|
|
S @AMAP@("ACTORRELATIONSOURCEID")=""
|
|
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
|
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|
Q
|
|
;
|
|
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,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)
|
|
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
|
|
S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
|
|
S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
|
|
S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
|
|
S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORTELEPHONE")=""
|
|
S @AMAP@("ACTORTELEPHONETYPE")=""
|
|
S ZX=$$TEL^CCRVA200(AIEN)
|
|
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
|
. S @AMAP@("ACTORTELEPHONE")=ZX
|
|
. S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
|
|
S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
|
|
S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
|
|
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
|
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|
Q
|
|
;
|