Changeset 1204 for ccr/trunk/p/C0CACTOR.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (14 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CACTOR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CACTOR.m
r770 r1204 1 C0CACTOR 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 EXTRACT(IPXML,ALST,AXML) 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 PATIENT(INXML,AIEN,AOID,OUTXML) 86 87 88 89 90 91 92 93 94 95 96 97 98 99 DEIDENT(GPL,ZDFN) 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 PEXTRACT(AMAP,AIEN,AOID) 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 MAP(INXML,AMAP,OUTXML) 185 186 187 188 SYSTEM(INXML,AIEN,AOID,OUTXML) 189 190 191 192 193 194 195 196 197 198 199 200 NOK(INXML,AIEN,AOID,OUTXML) 201 202 203 204 205 206 207 208 209 210 211 212 213 ORG(INXML,AIEN,AOID,OUTXML) 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 PROVIDER(INXML,AIEN,AOID,OUTXML) 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 1 C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 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 ; 29 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE 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 ; 85 PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR 86 I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! 87 ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE 88 ; CODE REUSABLE FROM ERX 89 N AMAP 90 S AMAP=$NA(^TMP($J,"AMAP")) 91 K @AMAP 92 D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR 93 I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1 94 I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR 95 D MAP(INXML,AMAP,OUTXML) ;MAP TO XML 96 K @AMAP ; CLEAN UP BEHIND US 97 Q 98 ; 99 DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR 100 S @GPL@("ACTORADDRESSCITY")="ALTON" 101 S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane" 102 S @GPL@("ACTORADDRESSLINE2")="" 103 S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN 104 S @GPL@("ACTORADDRESSSTATE")="KANSAS" 105 S @GPL@("ACTORADDRESSTYPE")="Home" 106 S @GPL@("ACTORADDRESSZIPCODE")=67623 107 S @GPL@("ACTORCELLTEL")="" 108 S @GPL@("ACTORCELLTELTEXT")="" 109 S @GPL@("ACTORDATEOFBIRTH")="1957-12-25" 110 S @GPL@("ACTOREMAIL")="" 111 S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN 112 ;S @GPL@("ACTORGENDER")="MALE" 113 S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN 114 S @GPL@("ACTORIEN")=2 115 S @GPL@("ACTORMIDDLENAME")="TWO" 116 S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN 117 S @GPL@("ACTORRESTEL")="888-555-1212" 118 S @GPL@("ACTORRESTELTEXT")="Residential Telephone" 119 S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1" 120 S @GPL@("ACTORSSN")="769122557P" 121 S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN 122 S @GPL@("ACTORSSNTEXT")="SSN" 123 S @GPL@("ACTORSUFFIXNAME")="" 124 S @GPL@("ACTORWORKTEL")="888-121-1212" 125 S @GPL@("ACTORWORKTELTEXT")="Work Telephone" 126 Q 127 ; 128 PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME 129 N ZX 130 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 131 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN) 132 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN) 133 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN) 134 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN) 135 S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2) 136 S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1) 137 S @AMAP@("ACTORSSN")="" 138 S @AMAP@("ACTORSSNTEXT")="" 139 S @AMAP@("ACTORSSNSOURCEID")="" 140 S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA 141 X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS 142 I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL 143 I $G(MRN)'="" D ; IF MRN IS PRESENT 144 . S @AMAP@("ACTORSSN")=MRN 145 . S @AMAP@("ACTORSSNTEXT")="MRN" 146 . S @AMAP@("ACTORSSNSOURCEID")=AOID 147 E D ; NO MRN, USE SSN 148 . S ZX=$$SSN^C0CDPT(AIEN) 149 . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD 150 . . S @AMAP@("ACTORSSN")=ZX 151 . . S @AMAP@("ACTORSSNTEXT")="SSN" 152 . . S @AMAP@("ACTORSSNSOURCEID")=AOID 153 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN) 154 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN) 155 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN) 156 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN) 157 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN) 158 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN) 159 S @AMAP@("ACTORRESTEL")="" 160 S @AMAP@("ACTORRESTELTEXT")="" 161 S ZX=$$RESTEL^C0CDPT(AIEN) 162 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 163 . S @AMAP@("ACTORRESTEL")=ZX 164 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone" 165 S @AMAP@("ACTORWORKTEL")="" 166 S @AMAP@("ACTORWORKTELTEXT")="" 167 S ZX=$$WORKTEL^C0CDPT(AIEN) 168 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 169 . S @AMAP@("ACTORWORKTEL")=ZX 170 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone" 171 S @AMAP@("ACTORCELLTEL")="" 172 S @AMAP@("ACTORCELLTELTEXT")="" 173 S ZX=$$CELLTEL^C0CDPT(AIEN) 174 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD 175 . S @AMAP@("ACTORCELLTEL")=ZX 176 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone" 177 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN) 178 S @AMAP@("ACTORADDRESSSOURCEID")=AOID 179 S @AMAP@("ACTORIEN")=AIEN 180 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX 181 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 182 Q 183 ; 184 MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML 185 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 186 Q 187 ; 188 SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR 189 ; 190 ; N AMAP 191 S AMAP=$NA(^TMP($J,"AMAP")) 192 K @AMAP 193 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 194 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS 195 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS 196 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID 197 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 198 Q 199 ; 200 NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR 201 ; 202 ; N AMAP 203 S AMAP=$NA(^TMP($J,"AMAP")) 204 K @AMAP 205 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 206 S @AMAP@("ACTORDISPLAYNAME")="" 207 S @AMAP@("ACTORRELATION")="" 208 S @AMAP@("ACTORRELATIONSOURCEID")="" 209 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 210 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 211 Q 212 ; 213 ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR 214 ; 215 N AMAP,ZIEN,ZSITE 216 S AMAP=$NA(^TMP($J,"AMAP")) 217 K @AMAP 218 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 219 S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE 220 S ZIEN=$P(ZSITE,"^",1) 221 S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2) 222 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" 223 S @AMAP@("ACTORADDRESSTYPE")="Office" 224 S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01) 225 S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02) 226 S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03) 227 S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02) 228 S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04) 229 S @AMAP@("ACTORTELEPHONE")="" 230 S @AMAP@("ACTORTELEPHONETYPE")="" 231 S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03) 232 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE 233 . S @AMAP@("ACTORTELEPHONE")=ZX 234 . S @AMAP@("ACTORTELEPHONETYPE")="Office" 235 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 236 K @AMAP 237 Q 238 ; 239 PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR 240 ; 241 ; N AMAP 242 S AMAP=$NA(^TMP($J,"AMAP")) 243 K @AMAP 244 I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN) 245 . W "WARNING - MISSING PROVIDER: ",AIEN,! 246 . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT 247 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 248 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN) 249 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN) 250 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN) 251 S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN) 252 S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1) 253 S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2) 254 S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3) 255 S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN) 256 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN) 257 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN) 258 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN) 259 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN) 260 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN) 261 S @AMAP@("ACTORTELEPHONE")="" 262 S @AMAP@("ACTORTELEPHONETYPE")="" 263 S ZX=$$TEL^C0CVA200(AIEN) 264 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE 265 . S @AMAP@("ACTORTELEPHONE")=ZX 266 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN) 267 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN) 268 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1" 269 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 270 S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1" 271 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 272 Q 273 ;
Note:
See TracChangeset
for help on using the changeset viewer.
