C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ;;1.0;C0C;;May 19, 2009;Build 1 ;Copyright 2008,2009 George Lilly, University of Minnesota. ;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^C0CCCR 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^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML D REPLACE^C0CXPATH(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 AIEN="" D Q ; IEN CAN'T BE NULL . . W "WARING NUL ACTOR: ",ATYP,! . I ATYP="" Q ; NOT A VALID ACTOR . ; . I DEBUG W AOID_" "_ATYP_" "_AIEN,! . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") . . D PATIENT("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="NOK" D ; NOK ACTOR TYPE . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") . . D NOK("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2") . ; . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") . . D ORG("ATMP",AIEN,AOID,"ATMP2") . ; . W "PROCESSING:",ATYP," ",AIEN,! . ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE ; N ACTTMP D MISSING^C0CXPATH(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,! ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE ; CODE REUSABLE FROM ERX N AMAP S AMAP=$NA(^TMP($J,"AMAP")) K @AMAP D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1 I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR D MAP(INXML,AMAP,OUTXML) ;MAP TO XML K @AMAP ; CLEAN UP BEHIND US Q ; DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR S @GPL@("ACTORADDRESSCITY")="ALTON" S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane" S @GPL@("ACTORADDRESSLINE2")="" S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN S @GPL@("ACTORADDRESSSTATE")="KANSAS" S @GPL@("ACTORADDRESSTYPE")="Home" S @GPL@("ACTORADDRESSZIPCODE")=67623 S @GPL@("ACTORCELLTEL")="" S @GPL@("ACTORCELLTELTEXT")="" S @GPL@("ACTORDATEOFBIRTH")="1957-12-25" S @GPL@("ACTOREMAIL")="" S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN ;S @GPL@("ACTORGENDER")="MALE" S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN S @GPL@("ACTORIEN")=2 S @GPL@("ACTORMIDDLENAME")="TWO" S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN S @GPL@("ACTORRESTEL")="888-555-1212" S @GPL@("ACTORRESTELTEXT")="Residential Telephone" S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1" S @GPL@("ACTORSSN")="769122557P" S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN S @GPL@("ACTORSSNTEXT")="SSN" S @GPL@("ACTORSUFFIXNAME")="" S @GPL@("ACTORWORKTEL")="888-121-1212" S @GPL@("ACTORWORKTELTEXT")="Work Telephone" Q ; PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME N ZX S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN) S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN) S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN) S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN) S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2) S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1) S @AMAP@("ACTORSSN")="" S @AMAP@("ACTORSSNTEXT")="" S @AMAP@("ACTORSSNSOURCEID")="" S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL I $G(MRN)'="" D ; IF MRN IS PRESENT . S @AMAP@("ACTORSSN")=MRN . S @AMAP@("ACTORSSNTEXT")="MRN" . S @AMAP@("ACTORSSNSOURCEID")=AOID E D ; NO MRN, USE SSN . S ZX=$$SSN^C0CDPT(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^C0CDPT(AIEN) S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN) S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN) S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN) S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN) S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN) S @AMAP@("ACTORRESTEL")="" S @AMAP@("ACTORRESTELTEXT")="" S ZX=$$RESTEL^C0CDPT(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^C0CDPT(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^C0CDPT(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^C0CDPT(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 Q ; MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML D MAP^C0CXPATH(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^C0CSYS S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS S @AMAP@("ACTORINFOSYSSOURCEID")=AOID D MAP^C0CXPATH(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^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR ; N AMAP,ZIEN,ZSITE S AMAP=$NA(^TMP($J,"AMAP")) K @AMAP S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE S ZIEN=$P(ZSITE,"^",1) S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2) S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" S @AMAP@("ACTORADDRESSTYPE")="Office" S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01) S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02) S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03) S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02) S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04) S @AMAP@("ACTORTELEPHONE")="" S @AMAP@("ACTORTELEPHONETYPE")="" S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03) I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE . S @AMAP@("ACTORTELEPHONE")=ZX . S @AMAP@("ACTORTELEPHONETYPE")="Office" D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE K @AMAP Q ; PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR ; ; N AMAP S AMAP=$NA(^TMP($J,"AMAP")) K @AMAP I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN) . W "WARNING - MISSING PROVIDER: ",AIEN,! . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN) S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN) S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN) S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN) S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1) S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2) S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3) S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN) S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN) S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN) S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN) S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN) S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN) S @AMAP@("ACTORTELEPHONE")="" S @AMAP@("ACTORTELEPHONETYPE")="" S ZX=$$TEL^C0CVA200(AIEN) I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE . S @AMAP@("ACTORTELEPHONE")=ZX . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN) S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN) S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1" S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1" D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ;