| [508] | 1 | C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
|---|
| 2 | ;;1.0;C0C;;May 19, 2009;
|
|---|
| [391] | 3 | ;Copyright 2008,2009 George Lilly, University of Minnesota.
|
|---|
| 4 | ;Licensed under the terms of the GNU General Public License.
|
|---|
| 5 | ;See attached copy of the License.
|
|---|
| 6 | ;
|
|---|
| 7 | ; This program is free software; you can redistribute it and/or modify
|
|---|
| 8 | ; it under the terms of the GNU General Public License as published by
|
|---|
| 9 | ; the Free Software Foundation; either version 2 of the License, or
|
|---|
| 10 | ; (at your option) any later version.
|
|---|
| 11 | ;
|
|---|
| 12 | ; This program is distributed in the hope that it will be useful,
|
|---|
| 13 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 14 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 15 | ; GNU General Public License for more details.
|
|---|
| 16 | ;
|
|---|
| 17 | ; You should have received a copy of the GNU General Public License along
|
|---|
| 18 | ; with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 19 | ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 20 | ;
|
|---|
| 21 | ; PROCESS THE ACTORS SECTION OF THE CCR
|
|---|
| 22 | ;
|
|---|
| 23 | ; ===Revision History===
|
|---|
| 24 | ; 0.1 Initial Writing of Skeleton--GPL
|
|---|
| 25 | ; 0.2 Patient Data Extraction--SMH
|
|---|
| 26 | ; 0.3 Information System Info Extraction--SMH
|
|---|
| 27 | ; 0.4 Patient data rouine refactored; adjustments here--SMH
|
|---|
| 28 | ;
|
|---|
| [508] | 29 | EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
|---|
| [391] | 30 | ; IPXML is the Input Actor Template into which we substitute values
|
|---|
| 31 | ; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
|---|
| 32 | ; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
|
|---|
| 33 | ; ^TMP(7542,1,"ACTORS",0)=Count
|
|---|
| 34 | ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
|---|
| 35 | ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
|---|
| 36 | ; AXML is the output arrary, to contain XML.
|
|---|
| 37 | ;
|
|---|
| 38 | N I,J,AMAP,AOID,ATYP,AIEN
|
|---|
| 39 | D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
|---|
| 40 | D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
|---|
| 41 | I DEBUG W "PROCESSING ACTORS ",!
|
|---|
| 42 | F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
|---|
| 43 | . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
|---|
| 44 | . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
|---|
| 45 | . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
|---|
| 46 | . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
|---|
| 47 | . I AIEN="" D Q ; IEN CAN'T BE NULL
|
|---|
| 48 | . . W "WARING NUL ACTOR: ",ATYP,!
|
|---|
| 49 | . I ATYP="" Q ; NOT A VALID ACTOR
|
|---|
| 50 | . ;
|
|---|
| 51 | . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
|---|
| 52 | . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
|---|
| 53 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
|---|
| 54 | . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| 55 | . ;
|
|---|
| 56 | . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
|---|
| 57 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
|---|
| 58 | . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| 59 | . ;
|
|---|
| 60 | . I ATYP="NOK" D ; NOK ACTOR TYPE
|
|---|
| 61 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
|---|
| 62 | . . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| 63 | . ;
|
|---|
| 64 | . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
|---|
| 65 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
|---|
| 66 | . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| 67 | . ;
|
|---|
| 68 | . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
|---|
| 69 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
|---|
| 70 | . . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| 71 | . ;
|
|---|
| 72 | . W "PROCESSING:",ATYP," ",AIEN,!
|
|---|
| 73 | . ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE
|
|---|
| 74 | . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
|---|
| 75 | . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
|
|---|
| 76 | ;
|
|---|
| 77 | N ACTTMP
|
|---|
| 78 | D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
|---|
| 79 | I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
|---|
| 80 | . ; STRINGS MARKED AS @@X@@
|
|---|
| 81 | . W "ACTORS Missing list: ",!
|
|---|
| 82 | . F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| [508] | 85 | PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
|---|
| [391] | 86 | I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
|---|
| 87 | N AMAP,ZX
|
|---|
| 88 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| 89 | K @AMAP
|
|---|
| 90 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| [415] | 91 | S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
|
|---|
| 92 | S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
|
|---|
| 93 | S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
|
|---|
| 94 | S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
|
|---|
| 95 | S @AMAP@("ACTORGENDER")=$$GENDER^C0CDPT(AIEN)
|
|---|
| [391] | 96 | S @AMAP@("ACTORSSN")=""
|
|---|
| 97 | S @AMAP@("ACTORSSNTEXT")=""
|
|---|
| 98 | S @AMAP@("ACTORSSNSOURCEID")=""
|
|---|
| 99 | S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
|
|---|
| 100 | X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
|
|---|
| 101 | I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
|
|---|
| 102 | I $D(MRN) D ; IF MRN IS PRESENT
|
|---|
| 103 | . S @AMAP@("ACTORSSN")=MRN
|
|---|
| 104 | . S @AMAP@("ACTORSSNTEXT")="MRN"
|
|---|
| 105 | . S @AMAP@("ACTORSSNSOURCEID")=AOID
|
|---|
| 106 | E D ; NO MRN, USE SSN
|
|---|
| [415] | 107 | . S ZX=$$SSN^C0CDPT(AIEN)
|
|---|
| [391] | 108 | . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
|---|
| 109 | . . S @AMAP@("ACTORSSN")=ZX
|
|---|
| 110 | . . S @AMAP@("ACTORSSNTEXT")="SSN"
|
|---|
| 111 | . . S @AMAP@("ACTORSSNSOURCEID")=AOID
|
|---|
| [415] | 112 | S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
|
|---|
| 113 | S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
|
|---|
| 114 | S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
|
|---|
| 115 | S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
|
|---|
| 116 | S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
|
|---|
| 117 | S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
|
|---|
| [391] | 118 | S @AMAP@("ACTORRESTEL")=""
|
|---|
| 119 | S @AMAP@("ACTORRESTELTEXT")=""
|
|---|
| [415] | 120 | S ZX=$$RESTEL^C0CDPT(AIEN)
|
|---|
| [391] | 121 | I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
|---|
| 122 | . S @AMAP@("ACTORRESTEL")=ZX
|
|---|
| 123 | . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
|---|
| 124 | S @AMAP@("ACTORWORKTEL")=""
|
|---|
| 125 | S @AMAP@("ACTORWORKTELTEXT")=""
|
|---|
| [415] | 126 | S ZX=$$WORKTEL^C0CDPT(AIEN)
|
|---|
| [391] | 127 | I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
|---|
| 128 | . S @AMAP@("ACTORWORKTEL")=ZX
|
|---|
| 129 | . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
|---|
| 130 | S @AMAP@("ACTORCELLTEL")=""
|
|---|
| 131 | S @AMAP@("ACTORCELLTELTEXT")=""
|
|---|
| [415] | 132 | S ZX=$$CELLTEL^C0CDPT(AIEN)
|
|---|
| [391] | 133 | I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
|---|
| 134 | . S @AMAP@("ACTORCELLTEL")=ZX
|
|---|
| 135 | . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
|---|
| [415] | 136 | S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
|
|---|
| [391] | 137 | S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
|---|
| 138 | S @AMAP@("ACTORIEN")=AIEN
|
|---|
| 139 | S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
|---|
| 140 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
|---|
| 141 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 142 | Q
|
|---|
| 143 | ;
|
|---|
| [508] | 144 | SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
|
|---|
| [391] | 145 | ;
|
|---|
| 146 | ; N AMAP
|
|---|
| 147 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| 148 | K @AMAP
|
|---|
| 149 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| [399] | 150 | S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
|
|---|
| 151 | S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
|
|---|
| [391] | 152 | S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
|---|
| 153 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 154 | Q
|
|---|
| 155 | ;
|
|---|
| [508] | 156 | NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
|
|---|
| [391] | 157 | ;
|
|---|
| 158 | ; N AMAP
|
|---|
| 159 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| 160 | K @AMAP
|
|---|
| 161 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| 162 | S @AMAP@("ACTORDISPLAYNAME")=""
|
|---|
| 163 | S @AMAP@("ACTORRELATION")=""
|
|---|
| 164 | S @AMAP@("ACTORRELATIONSOURCEID")=""
|
|---|
| 165 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
|---|
| 166 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 167 | Q
|
|---|
| 168 | ;
|
|---|
| [508] | 169 | ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
|
|---|
| [391] | 170 | ;
|
|---|
| 171 | ; N AMAP
|
|---|
| 172 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| 173 | K @AMAP
|
|---|
| 174 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| 175 | S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
|
|---|
| 176 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
|---|
| 177 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 178 | Q
|
|---|
| 179 | ;
|
|---|
| [508] | 180 | PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
|
|---|
| [391] | 181 | ;
|
|---|
| 182 | ; N AMAP
|
|---|
| 183 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| 184 | K @AMAP
|
|---|
| 185 | I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
|
|---|
| 186 | . W "WARNING - MISSING PROVIDER: ",AIEN,!
|
|---|
| 187 | . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
|
|---|
| 188 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| [397] | 189 | S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
|
|---|
| 190 | S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
|
|---|
| 191 | S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
|
|---|
| 192 | S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
|
|---|
| 193 | S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
|
|---|
| 194 | S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
|
|---|
| 195 | S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
|
|---|
| 196 | S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
|
|---|
| 197 | S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
|
|---|
| 198 | S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
|
|---|
| 199 | S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
|
|---|
| 200 | S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
|
|---|
| 201 | S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
|
|---|
| [391] | 202 | S @AMAP@("ACTORTELEPHONE")=""
|
|---|
| 203 | S @AMAP@("ACTORTELEPHONETYPE")=""
|
|---|
| [397] | 204 | S ZX=$$TEL^C0CVA200(AIEN)
|
|---|
| [391] | 205 | I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
|---|
| 206 | . S @AMAP@("ACTORTELEPHONE")=ZX
|
|---|
| [397] | 207 | . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
|
|---|
| 208 | S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
|
|---|
| [391] | 209 | S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
|
|---|
| 210 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
|---|
| 211 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 212 | Q
|
|---|
| 213 | ;
|
|---|
