Changeset 1428
- Timestamp:
- May 11, 2012, 6:06:25 PM (12 years ago)
- Location:
- ccr/branches/ohum/p
- Files:
-
- 9 added
- 70 edited
-
C0CACTOR.m (modified) (1 diff)
-
C0CALERT.m (modified) (1 diff)
-
C0CBAT.m (modified) (1 diff)
-
C0CCCD.m (modified) (1 diff)
-
C0CCCD1.m (modified) (1 diff)
-
C0CCCR.m (modified) (1 diff)
-
C0CCCR0.m (modified) (1 diff)
-
C0CCMT.m (modified) (1 diff)
-
C0CCPT.m (modified) (1 diff)
-
C0CDIC.m (modified) (1 diff)
-
C0CDOM.m (modified) (1 diff)
-
C0CDPT.m (modified) (1 diff)
-
C0CENC.m (modified) (1 diff)
-
C0CENV.m (modified) (1 diff)
-
C0CEVC.m (modified) (1 diff)
-
C0CEWD.m (modified) (1 diff)
-
C0CEWD1.m (modified) (1 diff)
-
C0CFM1.m (modified) (1 diff)
-
C0CFM2.m (modified) (1 diff)
-
C0CFM3.m (modified) (1 diff)
-
C0CIM2.m (modified) (1 diff)
-
C0CIMMU.m (modified) (1 diff)
-
C0CIN.m (modified) (1 diff)
-
C0CLA7DD.m (modified) (1 diff)
-
C0CLA7Q.m (modified) (1 diff)
-
C0CLABS.m (modified) (1 diff)
-
C0CMAIL.m (modified) (1 diff)
-
C0CMAIL2.m (modified) (1 diff)
-
C0CMAIL3.m (modified) (1 diff)
-
C0CMCCD.m (modified) (1 diff)
-
C0CMED.m (modified) (1 diff)
-
C0CMED1.m (modified) (1 diff)
-
C0CMED2.m (modified) (1 diff)
-
C0CMED3.m (modified) (1 diff)
-
C0CMED4.m (modified) (1 diff)
-
C0CMED6.m (modified) (1 diff)
-
C0CMIME.m (modified) (1 diff)
-
C0CMXML.m (modified) (1 diff)
-
C0CMXMLB.m (modified) (1 diff)
-
C0CMXP.m (modified) (1 diff)
-
C0CNHIN.m (modified) (1 diff)
-
C0CNMED2.m (modified) (1 diff)
-
C0CNMED4.m (modified) (1 diff)
-
C0CORSLT.m (modified) (1 diff)
-
C0COVREL.m (added)
-
C0COVRES.m (added)
-
C0COVREU.m (added)
-
C0CPARMS.m (modified) (1 diff)
-
C0CPROBS.m (modified) (1 diff)
-
C0CPROC.m (modified) (1 diff)
-
C0CPXRM.m (modified) (1 diff)
-
C0CQRY1.m (modified) (1 diff)
-
C0CQRY2.m (modified) (1 diff)
-
C0CRAHL7.m (added)
-
C0CRARPT.m (added)
-
C0CRIMA.m (modified) (1 diff)
-
C0CRNF.m (modified) (1 diff)
-
C0CRNFRP.m (modified) (1 diff)
-
C0CRPMS.m (modified) (1 diff)
-
C0CRXN.m (modified) (1 diff)
-
C0CRXNRD.m (modified) (1 diff)
-
C0CSNOA.m (modified) (1 diff)
-
C0CSOAP.m (modified) (1 diff)
-
C0CSQMB.m (added)
-
C0CSUB1.m (modified) (1 diff)
-
C0CSYS.m (modified) (1 diff)
-
C0CTIU.m (added)
-
C0CTIU1.m (added)
-
C0CUNIT.m (modified) (1 diff)
-
C0CUTIL.m (modified) (1 diff)
-
C0CVA200.m (modified) (1 diff)
-
C0CVALID.m (added)
-
C0CVIT2.m (modified) (1 diff)
-
C0CVITAL.m (modified) (1 diff)
-
C0CVOBX1.m (modified) (1 diff)
-
C0CVORU.m (modified) (1 diff)
-
C0CXEWD.m (modified) (1 diff)
-
C0CXPAT0.m (modified) (1 diff)
-
C0CXPATH.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CACTOR.m
r1342 r1428 1 C0CACTOR 2 ;;1.0;C0C;;May 19, 2009;Build 2 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.2;C0C;;May 11, 2012;Build 46 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 ; -
ccr/branches/ohum/p/C0CALERT.m
r1342 r1428 1 C0CALERT 2 ;;1.0;C0C;;May 19, 2009;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) 25 26 27 28 29 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 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 129 PRSGLB(INGLB) 130 131 132 1 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 2 ;;1.2;C0C;;May 11, 2012;Build 46 3 ;Copyright 2008,2009 George Lilly, University of Minnesota and others. 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 W "NO ENTRY FROM TOP",! 22 Q 23 ; 24 EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE 25 ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING 26 ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 27 ; 28 ; GET ADVERSE REACTIONS AND ALLERGIES 29 ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES 30 S GMRA="0^0^111" 31 D EN1^GMRADPT 32 I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT* 33 . S @ALTOUTXML@(0)=0 34 ; DEFINE MAPPING 35 N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP 36 S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS")) 37 S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP")) 38 K @ALTTVMAP,@ALTTARYTMP 39 N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1 40 S ALTTMP="" ; 41 F S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP="" D ; CHANGED TO $O BY GPL 42 . W "ALTTMP="_ALTTMP,! 43 . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q 44 . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT)) 45 . K @ALTVMAP 46 . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT 47 . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES 48 . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING 49 . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM 50 . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG 51 . N ADT S ADT="Patient has an " ; X $ZINT H 5 52 . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN") 53 . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"." 54 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT 55 . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ; 56 . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy 57 . N ALTCDE ; SNOMED CODE THE THE ALERT 58 . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC 59 . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ; 60 . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE 61 . ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE 62 . I ALTCDE'="" D ; IF THERE IS A CODE 63 . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT" 64 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008" 65 . E D ; SET TO NULL 66 . . S @ALTVMAP@("ALERTCODESYSTEM")="" 67 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="" 68 . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS? 69 . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN 70 . I ALTPROV'="" D ; PROVIDER PROVIDEED 71 . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV 72 . E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN 73 . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),! 74 . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP 75 . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z, 76 . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER 77 . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT 78 . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT 79 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT 80 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS? 81 . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT 82 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM 83 . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION 84 . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE 85 . I ACVUID'="" D ; IF VUID IS NOT NULL 86 . . S ZC=$$CODE^C0CUTIL(ACVUID) 87 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 88 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 89 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 90 . E D ; IF REACTANT CODE VALUE IS NULL 91 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS 92 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ; 93 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,! 94 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="" 95 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="" 96 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD 97 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS 98 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD 99 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD 100 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW 101 . N ARTMP,ARIEN,ARDES,ARVUID 102 . S (ARTMP,ARDES,ARVUID)="" 103 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS 104 . . S ARTMP=@ALTG@(ALTTMP,"S",1) 105 . . W "REACTION:",ARTMP,! 106 . . S ARIEN=$P(ARTMP,";",2) 107 . . S ARDES=$P(ARTMP,";",1) 108 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID") 109 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES 110 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL 111 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID 112 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID" 113 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM 114 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="" 115 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="" 116 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) 117 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION 118 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 119 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME 120 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") 121 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT") 122 . K @ALTARYTMP 123 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) 124 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) 125 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP) 126 . S ALTCNT=ALTCNT+1 127 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS 128 Q 129 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 130 ; INGLB IS OF THE FORM: PSNDF(50.6, 131 ; RETURN 50.6 132 Q $P($P(INGLB,"(",2),",",1) ; -
ccr/branches/ohum/p/C0CBAT.m
r1342 r1428 1 C0CBAT 2 ;;1.0;C0C;;May 19, 2009;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 STOP 24 25 26 27 28 29 30 31 32 33 34 35 START 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 EN 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 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 BLDHOT(ZHB) 149 150 151 152 153 154 155 156 157 158 COUNT(ZB) 159 160 161 162 163 164 165 166 UPDIEVARPTR(ZVAR,ZTYP) 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 UPDIE 189 190 191 192 193 194 195 196 197 198 199 SETFDA(C0CSN,C0CSV) 200 201 202 203 204 205 206 207 208 209 ZFILE(ZFN,ZTAB) 210 211 212 213 214 215 216 217 ZFIELD(ZFN,ZTAB) 218 219 220 221 222 223 224 225 226 ZVALUE(ZFN,ZTAB) 227 228 229 230 231 232 233 234 1 C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09 2 ;;1.2;C0C;;May 11, 2012;Build 46 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "This is the CCR Batch Utility Library ",! 21 Q 22 ; 23 STOP ; STOP A CURRENTLY RUNNING BATCH JOB 24 I '$D(^TMP("C0CBAT","RUNNING")) Q ; 25 W !,!,"HALTING CCR BATCH",! 26 S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE 27 H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED 28 I '$D(^TMP("C0CBAT","STOP")) D ; SIGNAL RECEIVED 29 . W "CCR BATCH JOB TERMINATING",! 30 E D ; 31 . K ^TMP("C0CBAT","STOP") ; STOP SIGNALING 32 . W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",! 33 Q 34 ; 35 START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION 36 ; 37 I $D(^TMP("C0CBAT","RUNNING")) D Q ; ONLY ONE ALLOWED AT A TIME 38 . W !,"CCR BATCH ALREADY RUNNING",! 39 . W !,"STOP FIRST WITH STOP^C0CBAT",! 40 N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO 41 S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch" 42 S ZTDTH=$H ; 43 ;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10)) 44 S ZTSAVE("C0C")="",ZTSAVE("C0C*")="" 45 S ZTIO="NULL" ; 46 W !,!,"CCR BATCH JOB STARTED",! 47 D ^%ZTLOAD 48 Q 49 ; 50 EN ; BATCH ENTRY POINT 51 ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH 52 ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE, 53 ; GENERATES A NEW CCR FOR THE PATIENT 54 ; UPDATES THE E2 CCR ELEMENTS FILE 55 ; 56 S C0CQT=1 ; QUIET MODE 57 I $D(^TMP("C0CBAT","RUNNING")) Q ; ONLY ONE AT A TIME 58 S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL 59 S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN 60 S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE 61 S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE 62 S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA 63 I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST 64 . W "WORK AREA ERROR",! 65 . B 66 S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA 67 S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST 68 S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE 69 ;I $D(^C0CB("B",C0CDT)) D ; BATCH RECORD EXISTS 70 ;. H 10 ; HANG 10 SECONDS 71 ;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN 72 ;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK 73 D BLDHOT(C0CBH) ; BUILD THE HOT LIST 74 S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST 75 S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS 76 S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL 77 S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM 78 S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS 79 S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST 80 D UPDIE ; CREATE THE BATCH RECORD 81 S C0CIEN=$O(^C0CB("B",C0CBDT,"")) 82 S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST 83 S C0CBCUR="" ; CURRENT PATIENT 84 S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")="" 85 ;F S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR="" D ; HOT LIST LATEST FIRST 86 F S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; HOT LIST FIRST 87 . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900") 88 . I $G(C0CCHK) D ; 89 . . D PUTRIM^C0CFM2(C0CBCUR) 90 . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR 91 . . K C0CFDA 92 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR 93 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y" 94 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR)) 95 . . D UPDIE ; CREATE UPDATE SUBFILE 96 . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL 97 . S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL 98 . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS 99 . S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS 100 . S C0CNOW=$$NOW^XLFDT 101 . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD 102 . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS 103 . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME 104 . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME 105 . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 106 . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START 107 . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME 108 . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED 109 . D UPDIE ; 110 . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED 111 . . S C0CSTOP=1 112 . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 113 . H 1 ; GIVE OTHERS A CHANCE 114 F S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; SUBS LIST 115 . I $D(@C0CBH@(C0CBCUR)) Q ; SKIP IF IN HOT LIST - ALREADY DONE 116 . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760") 117 . I $G(C0CCHK) D ; IF CHECKSUMS HAVE CHANGED 118 . . D PUTRIM^C0CFM2(C0CBCUR) 119 . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR 120 . . K C0CFDA 121 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR 122 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y" 123 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR)) 124 . . D UPDIE ; CREATE UPDATE SUBFILE 125 . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL 126 . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS 127 . S C0CNOW=$$NOW^XLFDT 128 . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD 129 . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS 130 . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME 131 . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME 132 . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 133 . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START 134 . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME 135 . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; 136 . D UPDIE ; 137 . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED 138 . . S C0CSTOP=1 139 . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 140 . H 1 ; GIVE IT A BREAK 141 I (C0CSTOP) S C0CDISP="KILLED" 142 E S C0CDISP="FINISHED" 143 S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP 144 D UPDIE ; SET DISPOSITION FIELD 145 K ^TMP("C0CBAT","RUNNING") 146 Q 147 ; 148 BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME 149 ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE 150 N ZDFN 151 S ZDFN="" 152 F S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN="" D ; ALL PATIENTS IN THE AC INDX 153 . S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT(" 154 . I '$D(@C0CBS@(ZZDFN)) Q ; SKIP IF NOT IN SUBSCRIPTION LIST 155 . S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST 156 Q 157 ; 158 COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS 159 N ZI,ZN 160 S ZN=0 161 S ZI="" 162 F S ZI=$O(@ZB@(ZI)) Q:ZI="" D ; 163 . S ZN=ZN+1 164 Q ZN 165 ; 166 UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 167 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 168 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 169 ; 170 N ZCCRD,ZVARN,C0CFDA2 171 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 172 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 173 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 174 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 175 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 176 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 177 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 178 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 179 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 180 . I $D(ZERR) D ; LAYGO ERROR 181 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 182 . E D ; 183 . . D CLEAN^DILF ; CLEAN UP 184 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 185 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 186 Q ZVARN 187 ; 188 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 189 K ZERR 190 D CLEAN^DILF 191 D UPDATE^DIE("","C0CFDA","","ZERR") 192 I $D(ZERR) D ; 193 . W "ERROR",! 194 . ZWR ZERR 195 . B 196 K C0CFDA 197 Q 198 ; 199 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 200 ; TO SET TO VALUE C0CSV. 201 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 202 ; C0CSN,C0CSV ARE PASSED BY VALUE 203 ; 204 N C0CSI,C0CSJ 205 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 206 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 207 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV 208 Q 209 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 210 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 211 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 212 I '$D(ZTAB) S ZTAB="C0CA" 213 N ZR 214 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 215 E S ZR="" 216 Q ZR 217 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 218 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 219 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 220 I '$D(ZTAB) S ZTAB="C0CA" 221 N ZR 222 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 223 E S ZR="" 224 Q ZR 225 ; 226 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 227 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 228 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 229 I '$D(ZTAB) S ZTAB="C0CA" 230 N ZR 231 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 232 E S ZR="" 233 Q ZR 234 ; -
ccr/branches/ohum/p/C0CCCD.m
r1342 r1428 1 C0CCCD 2 ;;1.0;C0C;;May 19, 2009;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 EXPORT 24 25 26 27 28 29 30 31 XPAT(DFN,DIR,FN) 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) 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 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 INITSTPS(TAB) 149 150 151 152 153 154 155 156 157 SHAVE(SHXML) 158 159 160 161 162 163 164 165 166 167 168 169 170 UNSHAVE(ORIGXML,SHXML) 171 172 173 174 175 176 177 178 179 180 181 182 183 HDRMAP(CXML,DFN,IHDR) 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 ACTLST(AXML,ACTRTN) 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 TEST 228 229 230 231 ZTEST(WHICH) 232 233 234 235 236 237 TLIST 238 239 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 1 C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 46 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 ; EXPORT A CCR 22 ; 23 EXPORT ; EXPORT ENTRY POINT FOR CCR 24 ; Select a patient. 25 S DIC=2,DIC(0)="AEMQ" D ^DIC 26 I Y<1 Q ; EXIT 27 S DFN=$P(Y,U,1) ; SET THE PATIENT 28 D XPAT(DFN,"","") ; EXPORT TO A FILE 29 Q 30 ; 31 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 32 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 33 ; FN IS FILE NAME, DEFAULTS IF NULL 34 ; N CCDGLO 35 D CCDRPC(.CCDGLO,DFN,"CCD","","","") 36 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1)) 37 S ONAM=FN 38 I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml" 39 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 40 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 41 . S @ODIRGLB="/home/glilly/CCROUT" 42 . ;S @ODIRGLB="/home/cedwards/" 43 . ;S @ODIRGLB="/opt/wv/p/" 44 S ODIR=DIR 45 I DIR="" S ODIR=@ODIRGLB 46 N ZY 47 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 48 W $P(ZY,U,2) 49 Q 50 ; 51 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 52 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 53 ; DFN IS PATIENT IEN 54 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 55 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 56 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 57 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME 58 ; - NULL MEANS NOW 59 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND 60 ; "TO" VARIABLES 61 ; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN 62 I '$D(DEBUG) S DEBUG=0 63 N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD 64 I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD 65 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 66 I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD 67 E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 68 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 69 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 70 S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 71 I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE 72 E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 73 D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 74 N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES 75 S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT 76 S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD 77 S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT 78 S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO 79 S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP 80 S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP 81 ; 82 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 83 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 84 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body") 85 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors") 86 I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures") 87 I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),! 88 ; 89 I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 90 ; MAPPING THE PATIENT PORTION OF THE CDA HEADER 91 S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient" 92 D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1") 93 D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT 94 I DEBUG D PARY^C0CXPATH("ACTT2") 95 D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX) 96 I DEBUG D PARY^C0CXPATH(CCDGLO) 97 K ACTT1 K ACCT2 98 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER 99 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION 100 D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG 101 D CP^C0CXPATH("ACTT2",CCDGLO) 102 ; 103 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 104 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 105 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 106 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 107 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 108 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE 109 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 110 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 111 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 112 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 113 . S IXML="INXML" 114 . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION 115 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 116 . ; W OXML,! 117 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 118 . W "RUNNING ",CALL,! 119 . X CALL 120 . I @OXML@(0)'=0 D ; THERE IS A RESULT 121 . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH 122 . . I CCD D UNSHAVE("ITMP",OXML) 123 . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION 124 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 125 . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body") 126 . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 127 ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE 128 ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST 129 ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 130 ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 131 ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 132 N I,J,DONE S DONE=0 133 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 134 . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS 135 . W "TRIMMED",J,! 136 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 137 I CCD D ; TURN THE BODY INTO A CCD COMPONENT 138 . N I 139 . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY 140 . . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP 141 . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ 142 . . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP 143 . . . S @CCDGLO@(I)="</structuredBody></component>" 144 S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD 145 S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE 146 Q 147 ; 148 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 149 ; TAB IS PASSED BY NAME 150 W "TAB= ",TAB,! 151 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 152 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 153 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 154 I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 155 Q 156 ; 157 SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT 158 ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION 159 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST 160 W SHXML,! 161 W @SHXML@(1),! 162 D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED 163 D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART 164 D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE 165 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 166 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 167 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 168 Q 169 ; 170 UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE 171 ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML 172 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST 173 W SHXML,! 174 W @SHXML@(1),! 175 D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE 176 D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST 177 D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP 178 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 179 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 180 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 181 Q 182 ; 183 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 184 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 185 ; K @VMAP 186 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 187 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 188 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 189 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 190 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 191 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 192 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 193 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 194 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 195 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 196 . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 197 N CTMP 198 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 199 D CP^C0CXPATH("CTMP",CXML) 200 Q 201 ; 202 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 203 ; AXML AND ACTRTN ARE PASSED BY NAME 204 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 205 ; P1= OBJECTID - ACTORPATIENT_2 206 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 207 ;OR INSTITUTION 208 ; OR PERSON(IN PATIENT FILE IE NOK) 209 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 210 N I,J,K,L 211 K @ACTRTN ; CLEAR RETURN ARRAY 212 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 213 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 214 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 215 . . W "<ActorID>=>",J,! 216 . . I J'="" S K(J)="" ; HASHING ACTOR 217 . . ; TO GET RID OF DUPLICATES 218 S I="" ; GOING TO $O THROUGH THE HASH 219 F J=0:0 D Q:$O(K(I))="" ; 220 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 221 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 222 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 223 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 224 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 225 Q 226 ; 227 TEST ; RUN ALL THE TEST CASES 228 D TESTALL^C0CUNIT("C0CCCR") 229 Q 230 ; 231 ZTEST(WHICH) ; RUN ONE SET OF TESTS 232 N ZTMP 233 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 234 D ZTEST^C0CUNIT(.ZTMP,WHICH) 235 Q 236 ; 237 TLIST ; LIST THE TESTS 238 N ZTMP 239 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 240 D TLIST^C0CUNIT(.ZTMP) 241 Q 242 ; 243 ;;><TEST> 244 ;;><PROBLEMS> 245 ;;>>>K C0C S C0C="" 246 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","") 247 ;;>>?@C0C@(@C0C@(0))["</Problems>" 248 ;;><VITALS> 249 ;;>>>K C0C S C0C="" 250 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","") 251 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 252 ;;><CCR> 253 ;;>>>K C0C S C0C="" 254 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") 255 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 256 ;;><ACTLST> 257 ;;>>>K C0C S C0C="" 258 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") 259 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 260 ;;><ACTORS> 261 ;;>>>D ZTEST^C0CCCR("ACTLST") 262 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 263 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 264 ;;>>?G3(G3(0))["</Actors>" 265 ;;><TRIM> 266 ;;>>>D ZTEST^C0CCCR("CCR") 267 ;;>>>W $$TRIM^C0CXPATH(CCDGLO) 268 ;;><CCD> 269 ;;>>>K C0C S C0C="" 270 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","") 271 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 272 ;;></TEST> -
ccr/branches/ohum/p/C0CCCD1.m
r1342 r1428 1 C0CCCD1 2 ;;1.0;C0C;;May 19, 2009;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ZT(ZARY,BAT,LINE) 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 ZLOAD(ZARY,ROUTINE) 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 LOAD(ARY) 61 62 63 64 65 TRMCCD 66 67 MARKUP 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 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 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 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 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 1 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 2 ;;1.2;C0C;;May 11, 2012;Build 46 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 W "This is a CCD TEMPLATE with processing routines",! 22 W ! 23 Q 24 ; 25 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 26 ; ZARY IS PASSED BY NAME 27 ; BAT is a string identifying the section 28 ; LINE is a test which will evaluate to true or false 29 ; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST ' 30 ; . S @ZARY@(0)=0 ; initially there are no elements 31 ; . W "GOT HERE LOADING "_LINE,! 32 N CNT ; count of array elements 33 S CNT=@ZARY@(0) ; contains array count 34 S CNT=CNT+1 ; increment count 35 S @ZARY@(CNT)=LINE ; put the line in the array 36 ; S @ZARY@(BAT,CNT)="" ; index the test by battery 37 S @ZARY@(0)=CNT ; update the array counter 38 Q 39 ; 40 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 41 ; ZARY IS PASSED BY NAME 42 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 43 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 44 K @ZARY S @ZARY="" 45 S @ZARY@(0)=0 ; initialize array count 46 N LINE,LABEL,BODY 47 N INTEST S INTEST=0 ; switch for in the TEMPLATE section 48 N SECTION S SECTION="[anonymous]" ; NO section LABEL 49 ; 50 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 51 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section 52 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section 53 . I INTEST D ; within the section 54 . . I LINE?." "1";><".E D ; sub-section name found 55 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name 56 . . I LINE?." "1";;".E D ; line found 57 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array 58 Q 59 ; 60 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 61 D ZLOAD(ARY,"C0CCCD1") 62 ; ZWR @ARY 63 Q 64 ; 65 TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD 66 Q 67 MARKUP ;<MARKUP> 68 ;;<Body> 69 ;;<Problems> 70 ;;</Problems> 71 ;;<FamilyHistory> 72 ;;</FamilyHistory> 73 ;;<SocialHistory> 74 ;;</SocialHistory> 75 ;;<Alerts> 76 ;;</Alerts> 77 ;;<Medications> 78 ;;</Medications> 79 ;;<VitalSigns> 80 ;;</VitalSigns> 81 ;;<Results> 82 ;;</Results> 83 ;;</Body> 84 ;;</ContinuityOfCareRecord> 85 ;</MARKUP> 86 ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd"> 87 ;;</ClinicalDocument> 88 Q 89 ; 90 ;<TEMPLATE> 91 ;;<?xml version="1.0"?> 92 ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?> 93 ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd"> 94 ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/> 95 ;;<templateId root="2.16.840.1.113883.10.20.1"/> 96 ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/> 97 ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/> 98 ;;<title>Continuity of Care Document</title> 99 ;;<effectiveTime value="20000407130000+0500"/> 100 ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/> 101 ;;<languageCode code="en-US"/> 102 ;;<recordTarget> 103 ;;<patientRole> 104 ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/> 105 ;;<patient> 106 ;;<name> 107 ;;<given>@@ACTORGIVENNAME@@</given> 108 ;;<family>@@ACTORFAMILYNAME@@</family> 109 ;;<suffix>@@ACTORSUFFIXNAME@@</suffix> 110 ;;</name> 111 ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/> 112 ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/> 113 ;;</patient> 114 ;;<providerOrganization> 115 ;;<id root="2.16.840.1.113883.19.5"/> 116 ;;<name>@@ORGANIZATIONNAME@@</name> 117 ;;</providerOrganization> 118 ;;</patientRole> 119 ;;</recordTarget> 120 ;;<author> 121 ;;<time value="20000407130000+0500"/> 122 ;;<assignedAuthor> 123 ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/> 124 ;;<assignedPerson> 125 ;;<name> 126 ;;<prefix>@@ACTORNAMEPREFIX@@</prefix> 127 ;;<given>@@ACTORGIVENNAME@@</given> 128 ;;<family>@@ACTORFAMILYNAME@@</family> 129 ;;</name> 130 ;;</assignedPerson> 131 ;;<representedOrganization> 132 ;;<id root="2.16.840.1.113883.19.5"/> 133 ;;<name>@@ORGANIZATIONNAME@@</name> 134 ;;</representedOrganization> 135 ;;</assignedAuthor> 136 ;;</author> 137 ;;<informant> 138 ;;<assignedEntity> 139 ;;<id nullFlavor="NI"/> 140 ;;<representedOrganization> 141 ;;<id root="2.16.840.1.113883.19.5"/> 142 ;;<name>@@ORGANIZATIONNAME@@</name> 143 ;;</representedOrganization> 144 ;;</assignedEntity> 145 ;;</informant> 146 ;;<custodian> 147 ;;<assignedCustodian> 148 ;;<representedCustodianOrganization> 149 ;;<id root="2.16.840.1.113883.19.5"/> 150 ;;<name>@@ORGANIZATIONNAME@@</name> 151 ;;</representedCustodianOrganization> 152 ;;</assignedCustodian> 153 ;;</custodian> 154 ;;<legalAuthenticator> 155 ;;<time value="20000407130000+0500"/> 156 ;;<signatureCode code="S"/> 157 ;;<assignedEntity> 158 ;;<id nullFlavor="NI"/> 159 ;;<representedOrganization> 160 ;;<id root="2.16.840.1.113883.19.5"/> 161 ;;<name>@@ORGANIZATIONNAME@@</name> 162 ;;</representedOrganization> 163 ;;</assignedEntity> 164 ;;</legalAuthenticator> 165 ;;<Actors> 166 ;;<ACTOR-NOK> 167 ;;<participant typeCode="IND"> 168 ;;<associatedEntity classCode="NOK"> 169 ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/> 170 ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/> 171 ;;<telecom value="tel:(999)555-1212"/> 172 ;;<associatedPerson> 173 ;;<name> 174 ;;<given>Henrietta</given> 175 ;;<family>Levin</family> 176 ;;</name> 177 ;;</associatedPerson> 178 ;;</associatedEntity> 179 ;;</participant> 180 ;;</ACTOR-NOK> 181 ;;</Actors> 182 ;;<documentationOf> 183 ;;<serviceEvent classCode="PCPR"> 184 ;;<effectiveTime> 185 ;;<high value="@@DATETIME@@"/> 186 ;;</effectiveTime> 187 ;;<performer typeCode="PRF"> 188 ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/> 189 ;;<time> 190 ;;<low value="1990"/> 191 ;;<high value='20000407'/> 192 ;;</time> 193 ;;<assignedEntity> 194 ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/> 195 ;;<assignedPerson> 196 ;;<name> 197 ;;<prefix>@@ACTORPREFIXNAME@@</prefix> 198 ;;<given>@@ACTORGIVENNAME@@</given> 199 ;;<family>@@ACTORFAMILYNAME@@</family> 200 ;;</name> 201 ;;</assignedPerson> 202 ;;<representedOrganization> 203 ;;<id root="2.16.840.1.113883.19.5"/> 204 ;;<name>@@ORGANIZATIONNAME@@</name> 205 ;;</representedOrganization> 206 ;;</assignedEntity> 207 ;;</performer> 208 ;;</serviceEvent> 209 ;;</documentationOf> 210 ;;<Body> 211 ;;<PROBLEMS-HTML> 212 ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody> 213 ;;<tr><td>@@PROBLEMDESCRIPTION@@</td> 214 ;;<td>@@PROBLEMDATEOFONSET@@</td> 215 ;;<td>Active</td></tr> 216 ;;</tbody></table></text> 217 ;;</PROBLEMS-HTML> 218 ;;<Problems> 219 ;;<component> 220 ;;<section> 221 ;;<templateId root='2.16.840.1.113883.10.20.1.11'/> 222 ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/> 223 ;;<title>Problems</title> 224 ;;<entry typeCode="DRIV"> 225 ;;<act classCode="ACT" moodCode="EVN"> 226 ;;<templateId root='2.16.840.1.113883.10.20.1.27'/> 227 ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/> 228 ;;<code nullFlavor="NA"/> 229 ;;<entryRelationship typeCode="SUBJ"> 230 ;;<observation classCode="OBS" moodCode="EVN"> 231 ;;<templateId root='2.16.840.1.113883.10.20.1.28'/> 232 ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/> 233 ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/> 234 ;;<statusCode code="completed"/> 235 ;;<effectiveTime> 236 ;;<low value="@@PROBLEMDATEOFONSET@@"/> 237 ;;</effectiveTime> 238 ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/> 239 ;;<entryRelationship typeCode="REFR"> 240 ;;<observation classCode="OBS" moodCode="EVN"> 241 ;;<templateId root='2.16.840.1.113883.10.20.1.50'/> 242 ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/> 243 ;;<statusCode code="completed"/> 244 ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/> 245 ;;</observation> 246 ;;</entryRelationship> 247 ;;</observation> 248 ;;</entryRelationship> 249 ;;</act> 250 ;;</entry> 251 ;;</section> 252 ;;</component> 253 ;;</Problems> 254 ;;<FamilyHistory> 255 ;;</FamilyHistory> 256 ;;<SocialHistory> 257 ;;</SocialHistory> 258 ;;<Alerts> 259 ;;</Alerts> 260 ;;<Medications> 261 ;;</Medications> 262 ;;<VitalSigns> 263 ;;</VitalSigns> 264 ;;<Results> 265 ;;</Results> 266 ;;</Body> 267 ;;</ClinicalDocument> 268 ;</TEMPLATE> -
ccr/branches/ohum/p/C0CCCR.m
r1342 r1428 1 C0CCCR 2 ;;1.0;C0C;;May 19, 2009;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 EXPORT 24 25 26 27 28 29 30 31 32 33 34 35 36 XPAT(DFN,XPARMS,DIR,FN) 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 DCCR(DFN) 67 68 69 70 71 72 73 74 75 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 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 INITSTPS(TAB) 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 HDRMAP(CXML,DFN) 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 ACTLST(AXML,ACTRTN) 210 211 212 213 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 240 241 242 243 244 TEST 245 246 247 248 ZTEST(WHICH) 249 250 251 252 253 254 TLIST 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 1 C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;1.2;C0C;;May 11, 2012;Build 46 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 ; EXPORT A CCR 22 ; 23 EXPORT ; EXPORT ENTRY POINT FOR CCR 24 ; Select a patient. 25 S DIC=2,DIC(0)="AEMQ" D ^DIC 26 I Y<1 Q ; EXIT 27 S DFN=$P(Y,U,1) ; SET THE PATIENT 28 ;OHUM/RUT 3120109 commented 29 ;;OHUM/RUT 3120102 To take inputs from user for date limits and notes 30 ;D ^C0CVALID 31 ;;OHUM/RUT 32 ;OHUM/RUT 33 D XPAT(DFN) ; EXPORT TO A FILE 34 Q 35 ; 36 XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 37 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 38 ; FN IS FILE NAME, DEFAULTS IF NULL 39 N CCRGLO,UDIR,UFN 40 S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC 41 I '$D(DIR) S UDIR="" 42 E S UDIR=DIR 43 I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED 44 E S UFN=FN 45 I '$D(XPARMS) S XPARMS="" 46 N C0CRTN ; RETURN ARRAY 47 D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR") 48 S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1)) 49 S ONAM=UFN 50 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml" 51 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 52 S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE 53 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR") 54 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 55 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q 56 . ;S @ODIRGLB="/home/glilly/CCROUT" 57 . ;S @ODIRGLB="/home/cedwards/" 58 . S @ODIRGLB="/opt/wv/p/" 59 S ODIR=UDIR 60 I UDIR="" S ODIR=@ODIRGLB 61 N ZY 62 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 63 W !,$P(ZY,U,2),! 64 Q 65 ; 66 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED 67 ; 68 N G1 69 S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) 70 I $D(@G1@(0)) D ; CCR EXISTS 71 . D PARY^C0CXPATH(G1) 72 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",! 73 Q 74 ; 75 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT 76 ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE 77 ; DFN IS PATIENT IEN 78 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 79 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 80 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 81 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 82 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 83 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 84 K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT 85 M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS 86 K ^TMP($J) ; START CLEAN 87 I '$D(DEBUG) S DEBUG=0 88 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD 89 I '$D(CCRPARMS) S CCRPARMS="" 90 I '$D(CCRPART) S CCRPART="CCR" 91 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)="" 92 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES 93 I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS 94 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION 95 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION 96 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION 97 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 98 S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 99 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 100 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 101 ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL 102 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 103 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 104 ; 105 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 106 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 107 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 108 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 109 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 110 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments") 111 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 112 ; 113 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES 114 ; 115 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 116 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 117 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 118 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 119 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 120 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE 121 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 122 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 123 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 124 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 125 . S IXML="INXML" 126 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 127 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY 128 . ; W OXML,! 129 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 130 . W "RUNNING ",CALL,! 131 . X CALL 132 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 133 . I $G(@OXML@(0))>0 D ; THERE IS A RESULT 134 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 135 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 136 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING 137 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 138 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 139 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 140 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 141 K ACTT,ACTT2 142 ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT") 143 ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2") 144 ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments") 145 ; gpl - turned off Comments for Certification 146 K CMTT,CMTT2 147 N TRIMI,J,DONE S DONE=0 148 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 149 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS 150 . I DEBUG W "TRIMMED",J,! 151 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 152 ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL 153 I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR 154 E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART 155 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))="" 156 K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP 157 K ^TMP($J) ; REALLY CLEAN UP 158 M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J 159 Q 160 ; 161 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 162 ; TAB IS PASSED BY NAME 163 I DEBUG W "TAB= ",TAB,! 164 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 165 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 166 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")") 167 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 168 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")") 169 I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 170 E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 171 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")") 172 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")") 173 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 174 ; gpl - turned off Encounters for Certification 175 ;OHUM/RUT 3120109 Changed the condition 176 ;;OHUM/RUT 3111228 Condition for Notes ; It should be included or not 177 ;;I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 178 I $P(^C0CPARM(1,2),"^",3)=1 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 179 ;;OHUM/RUT 180 ;OHUM/RUT 181 Q 182 ; 183 HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT 184 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 185 ; K @VMAP 186 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 187 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 188 D ; ALWAYS MAP THESE VARIABLES 189 . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR 190 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 191 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER 192 . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 193 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 194 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 195 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 196 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 197 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 198 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED 199 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 200 N CTMP 201 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 202 D CP^C0CXPATH("CTMP",CXML) 203 N HRIMVARS ; 204 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS 205 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE 206 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT 207 Q 208 ; 209 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 210 ; AXML AND ACTRTN ARE PASSED BY NAME 211 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 212 ; P1= OBJECTID - ACTORPATIENT_2 213 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 214 ;OR INSTITUTION 215 ; OR PERSON(IN PATIENT FILE IE NOK) 216 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 217 N I,J,K,L 218 K @ACTRTN ; CLEAR RETURN ARRAY 219 F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS 220 . I @AXML@(I)?.E1"_<".E D ; 221 . . N ZA,ZB 222 . . S ZA=$P(@AXML@(I),">",1)_">" 223 . . S ZB="<"_$P(@AXML@(I),"<",3) 224 . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB 225 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 226 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 227 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 228 . . I $G(LINKDEBUG) W "<ActorID>=>",J,! 229 . . I J'="" S K(J)="" ; HASHING ACTOR 230 . I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE 231 . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1) 232 . . I $G(LINKDEBUG) W "<LinkID>=>",J,! 233 . . I J'="" S K(J)="" ; HASHING ACTOR 234 . . ; TO GET RID OF DUPLICATES 235 S I="" ; GOING TO $O THROUGH THE HASH 236 F J=0:0 D Q:$O(K(I))="" 237 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 238 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 239 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 240 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 241 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 242 Q 243 ; 244 TEST ; RUN ALL THE TEST CASES 245 D TESTALL^C0CUNIT("C0CCCR") 246 Q 247 ; 248 ZTEST(WHICH) ; RUN ONE SET OF TESTS 249 N ZTMP 250 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 251 D ZTEST^C0CUNIT(.ZTMP,WHICH) 252 Q 253 ; 254 TLIST ; LIST THE TESTS 255 N ZTMP 256 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 257 D TLIST^C0CUNIT(.ZTMP) 258 Q 259 ; 260 ;;><TEST> 261 ;;><PROBLEMS> 262 ;;>>>K C0C S C0C="" 263 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","") 264 ;;>>?@C0C@(@C0C@(0))["</Problems>" 265 ;;><VITALS> 266 ;;>>>K C0C S C0C="" 267 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","") 268 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 269 ;;><CCR> 270 ;;>>>K C0C S C0C="" 271 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 272 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 273 ;;><ACTLST> 274 ;;>>>K C0C S C0C="" 275 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 276 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 277 ;;><ACTORS> 278 ;;>>>D ZTEST^C0CCCR("ACTLST") 279 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 280 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 281 ;;>>?G3(G3(0))["</Actors>" 282 ;;><TRIM> 283 ;;>>>D ZTEST^C0CCCR("CCR") 284 ;;>>>W $$TRIM^C0CXPATH(CCRGLO) 285 ;;><ALERTS> 286 ;;>>>S TESTALERT=1 287 ;;>>>K C0C S C0C="" 288 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") 289 ;;>>?@C0C@(@C0C@(0))["</Alerts>" 290 291 -
ccr/branches/ohum/p/C0CCCR0.m
r1342 r1428 1 C0CCCR0 2 ;;1.0;C0C;;May 19, 2009;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ZT(ZARY,BAT,LINE) 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 ZLOAD(ZARY,ROUTINE) 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 LOAD(ARY) 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 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 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 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 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 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 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 1 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08 2 ;;1.2;C0C;;May 11, 2012;Build 46 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 W "This is a CCR TEMPLATE with processing routines",! 22 W ! 23 Q 24 ; 25 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 26 ; ZARY IS PASSED BY NAME 27 ; BAT is a string identifying the section 28 ; LINE is a test which will evaluate to true or false 29 ; I '$G(@ZARY) D ; 30 ; . S @ZARY@(0)=0 ; initially there are no elements 31 ; . W "GOT HERE LOADING "_LINE,! 32 N CNT ; count of array elements 33 S CNT=@ZARY@(0) ; contains array count 34 S CNT=CNT+1 ; increment count 35 S @ZARY@(CNT)=LINE ; put the line in the array 36 ; S @ZARY@(BAT,CNT)="" ; index the test by battery 37 S @ZARY@(0)=CNT ; update the array counter 38 Q 39 ; 40 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 41 ; ZARY IS PASSED BY NAME 42 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 43 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 44 K @ZARY S @ZARY="" 45 S @ZARY@(0)=0 ; initialize array count 46 N LINE,LABEL,BODY 47 N INTEST S INTEST=0 ; switch for in the TEMPLATE section 48 N SECTION S SECTION="[anonymous]" ; NO section LABEL 49 ; 50 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 51 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section 52 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section 53 . I INTEST D ; within the section 54 . . I LINE?." "1";><".E D ; sub-section name found 55 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name 56 . . I LINE?." "1";;".E D ; line found 57 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array 58 Q 59 ; 60 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 61 D ZLOAD(ARY,"C0CCCR0") 62 ; ZWR @ARY 63 Q 64 ; 65 ;<TEMPLATE> 66 ;;<?xml version="1.0" encoding="UTF-8"?> 67 ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?> 68 ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR"> 69 ;;<CCRDocumentObjectID>@@CCRDOCOBJECTID@@</CCRDocumentObjectID> 70 ;;<Language> 71 ;;<Text>English</Text> 72 ;;</Language> 73 ;;<Version>V1.0</Version> 74 ;;<DateTime> 75 ;;<ExactDateTime>@@DATETIME@@</ExactDateTime> 76 ;;</DateTime> 77 ;;<Patient> 78 ;;<ActorID>@@ACTORPATIENT@@</ActorID> 79 ;;</Patient> 80 ;;<From> 81 ;;<ActorLink> 82 ;;<ActorID>@@ACTORFROM@@</ActorID> 83 ;;</ActorLink> 84 ;;<ActorLink> 85 ;;<ActorID>@@ACTORFROM2@@</ActorID> 86 ;;</ActorLink> 87 ;;</From> 88 ;;<To> 89 ;;<ActorLink> 90 ;;<ActorID>@@ACTORTO@@</ActorID> 91 ;;<ActorRole> 92 ;;<Text>@@ACTORTOTEXT@@</Text> 93 ;;</ActorRole> 94 ;;</ActorLink> 95 ;;</To> 96 ;;<Purpose> 97 ;;<Description> 98 ;;<Text>@@PURPOSEDESCRIPTION@@</Text> 99 ;;</Description> 100 ;;</Purpose> 101 ;;<Body> 102 ;;<Problems> 103 ;;<Problem> 104 ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID> 105 ;;<DateTime> 106 ;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime> 107 ;;</DateTime> 108 ;;<Type> 109 ;;<Text>Problem</Text> 110 ;;</Type> 111 ;;<Description> 112 ;;<Text>@@PROBLEMDESCRIPTION@@</Text> 113 ;;<Code> 114 ;;<Value>@@PROBLEMCODEVALUE@@</Value> 115 ;;<CodingSystem>ICD9CM</CodingSystem> 116 ;;<Version>@@PROBLEMCODINGVERSION@@</Version> 117 ;;</Code> 118 ;;</Description> 119 ;;<Status> 120 ;;<Text>@@PROBLEMSTATUS@@</Text> 121 ;;</Status> 122 ;;<Source> 123 ;;<Actor> 124 ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID> 125 ;;</Actor> 126 ;;</Source> 127 ;;</Problem> 128 ;;</Problems> 129 ;;<Immunizations> 130 ;;<Immunization> 131 ;;<CCRDataObjectID>@@IMMUNEOBJECTID@@</CCRDataObjectID> 132 ;;<DateTime> 133 ;;<Type> 134 ;;<Text>@@IMMUNEDATETIMETYPETEXT@@</Text> 135 ;;</Type> 136 ;;<ExactDateTime>@@IMMUNEDATETIME@@</ExactDateTime> 137 ;;</DateTime> 138 ;;<Source> 139 ;;<Actor> 140 ;;<ActorID>@@IMMUNESOURCEACTORID@@</ActorID> 141 ;;</Actor> 142 ;;</Source> 143 ;;<Product> 144 ;;<ProductName> 145 ;;<Text>@@IMMUNEPRODUCTNAMETEXT@@</Text> 146 ;;<Code> 147 ;;<Value>@@IMMUNEPRODUCTCODE@@</Value> 148 ;;<CodingSystem>@@IMMUNEPRODUCTCODESYSTEM@@</CodingSystem> 149 ;;</Code> 150 ;;</ProductName> 151 ;;</Product> 152 ;;</Immunization> 153 ;;</Immunizations> 154 ;;<FamilyHistory> 155 ;;<FamilyProblemHistory> 156 ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID> 157 ;;<Source> 158 ;;<Actor> 159 ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID> 160 ;;</Actor> 161 ;;</Source> 162 ;;<FamilyMember> 163 ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID> 164 ;;<ActorRole> 165 ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text> 166 ;;</ActorRole> 167 ;;<Source> 168 ;;<Actor> 169 ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID> 170 ;;</Actor> 171 ;;</Source> 172 ;;</FamilyMember> 173 ;;<Problem> 174 ;;<Type> 175 ;;<Text>Problem</Text> 176 ;;</Type> 177 ;;<Description> 178 ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text> 179 ;;<Code> 180 ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value> 181 ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem> 182 ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version> 183 ;;</Code> 184 ;;</Description> 185 ;;<Source> 186 ;;<Actor> 187 ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID> 188 ;;</Actor> 189 ;;</Source> 190 ;;</Problem> 191 ;;</FamilyProblemHistory> 192 ;;</FamilyHistory> 193 ;;<SocialHistory> 194 ;;<SocialHistoryElement> 195 ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID> 196 ;;<Type> 197 ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text> 198 ;;</Type> 199 ;;<Description> 200 ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text> 201 ;;</Description> 202 ;;<Source> 203 ;;<Actor> 204 ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID> 205 ;;</Actor> 206 ;;</Source> 207 ;;</SocialHistoryElement> 208 ;;<SocialHistoryElement> 209 ;;<CCRDataObjectID>BB0005</CCRDataObjectID> 210 ;;<Type> 211 ;;<Text>Ethnic Origin</Text> 212 ;;</Type> 213 ;;<Description> 214 ;;<Text>Not Hispanic or Latino</Text> 215 ;;</Description> 216 ;;<Source> 217 ;;<Actor> 218 ;;<ActorID>AA0001</ActorID> 219 ;;</Actor> 220 ;;</Source> 221 ;;</SocialHistoryElement> 222 ;;<SocialHistoryElement> 223 ;;<CCRDataObjectID>BB0006</CCRDataObjectID> 224 ;;<Type> 225 ;;<Text>Race</Text> 226 ;;</Type> 227 ;;<Description> 228 ;;<Text>White</Text> 229 ;;</Description> 230 ;;<Source> 231 ;;<Actor> 232 ;;<ActorID>AA0001</ActorID> 233 ;;</Actor> 234 ;;</Source> 235 ;;</SocialHistoryElement> 236 ;;<SocialHistoryElement> 237 ;;<CCRDataObjectID>BB0007</CCRDataObjectID> 238 ;;<Type> 239 ;;<Text>Occupation</Text> 240 ;;</Type> 241 ;;<Description> 242 ;;<Text>Physician</Text> 243 ;;</Description> 244 ;;<Source> 245 ;;<Actor> 246 ;;<ActorID>AA0001</ActorID> 247 ;;</Actor> 248 ;;</Source> 249 ;;</SocialHistoryElement> 250 ;;</SocialHistory> 251 ;;<Alerts> 252 ;;<Alert> 253 ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID> 254 ;;<DateTime> 255 ;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime> 256 ;;</DateTime> 257 ;;<Type> 258 ;;<Text>@@ALERTTYPE@@</Text> 259 ;;</Type> 260 ;;<Status> 261 ;;<Text>@@ALERTSTATUSTEXT@@</Text> 262 ;;</Status> 263 ;;<Description> 264 ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text> 265 ;;<Code> 266 ;;<Value>@@ALERTCODEVALUE@@</Value> 267 ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem> 268 ;;</Code> 269 ;;</Description> 270 ;;<Source> 271 ;;<Actor> 272 ;;<ActorID>@@ALERTSOURCEID@@</ActorID> 273 ;;</Actor> 274 ;;</Source> 275 ;;<Agent> 276 ;;<Products> 277 ;;<Product> 278 ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID> 279 ;;<Source> 280 ;;<Actor> 281 ;;<ActorID>@@ALERTSOURCEID@@</ActorID> 282 ;;</Actor> 283 ;;</Source> 284 ;;<Product> 285 ;;<ProductName> 286 ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text> 287 ;;<Code> 288 ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value> 289 ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem> 290 ;;</Code> 291 ;;</ProductName> 292 ;;</Product> 293 ;;</Product> 294 ;;</Products> 295 ;;</Agent> 296 ;;<Reaction> 297 ;;<Description> 298 ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text> 299 ;;<Code> 300 ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value> 301 ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem> 302 ;;</Code> 303 ;;</Description> 304 ;;</Reaction> 305 ;;</Alert> 306 ;;</Alerts> 307 ;;<Medications> 308 ;;<Medication> 309 ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID> 310 ;;<DateTime> 311 ;;<Type> 312 ;;<Text>@@MEDISSUEDATETXT@@</Text> 313 ;;</Type> 314 ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime> 315 ;;</DateTime> 316 ;;<DateTime> 317 ;;<Type> 318 ;;<Text>@@MEDLASTFILLDATETXT@@</Text> 319 ;;</Type> 320 ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime> 321 ;;</DateTime> 322 ;;<IDs> 323 ;;<Type> 324 ;;<Text>@@MEDRXNOTXT@@</Text> 325 ;;</Type> 326 ;;<ID>@@MEDRXNO@@</ID> 327 ;;</IDs> 328 ;;<Type> 329 ;;<Text>@@MEDTYPETEXT@@</Text> 330 ;;</Type> 331 ;;<Description> 332 ;;<Text>@@MEDDETAILUNADORNED@@</Text> 333 ;;</Description> 334 ;;<Status> 335 ;;<Text>@@MEDSTATUSTEXT@@</Text> 336 ;;</Status> 337 ;;<Source> 338 ;;<Actor> 339 ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID> 340 ;;</Actor> 341 ;;</Source> 342 ;;<Product> 343 ;;<ProductName> 344 ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text> 345 ;;<Code> 346 ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value> 347 ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem> 348 ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version> 349 ;;</Code> 350 ;;</ProductName> 351 ;;<BrandName> 352 ;;<Text>@@MEDBRANDNAMETEXT@@</Text> 353 ;;</BrandName> 354 ;;<Strength> 355 ;;<Value>@@MEDSTRENGTHVALUE@@</Value> 356 ;;<Units> 357 ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit> 358 ;;</Units> 359 ;;</Strength> 360 ;;<Form> 361 ;;<Text>@@MEDFORMTEXT@@</Text> 362 ;;</Form> 363 ;;<Concentration> 364 ;;<Value>@@MEDCONCVALUE@@</Value> 365 ;;<Units> 366 ;;<Unit>@@MEDCONCUNIT@@</Unit> 367 ;;</Units> 368 ;;</Concentration> 369 ;;</Product> 370 ;;<Quantity> 371 ;;<Value>@@MEDQUANTITYVALUE@@</Value> 372 ;;<Units> 373 ;;<Unit>@@MEDQUANTITYUNIT@@</Unit> 374 ;;</Units> 375 ;;</Quantity> 376 ;;<Directions> 377 ;;<Direction> 378 ;;<Description> 379 ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text> 380 ;;</Description> 381 ;;<DoseIndicator> 382 ;;<Text>@@MEDDOSEINDICATOR@@</Text> 383 ;;</DoseIndicator> 384 ;;<DeliveryMethod> 385 ;;<Text>@@MEDDELIVERYMETHOD@@</Text> 386 ;;</DeliveryMethod> 387 ;;<Dose> 388 ;;<Value>@@MEDDOSEVALUE@@</Value> 389 ;;<Units> 390 ;;<Unit>@@MEDDOSEUNIT@@</Unit> 391 ;;</Units> 392 ;;<Rate> 393 ;;<Value>@@MEDRATEVALUE@@</Value> 394 ;;<Units> 395 ;;<Unit>@@MEDRATEUNIT@@</Unit> 396 ;;</Units> 397 ;;</Rate> 398 ;;</Dose> 399 ;;<Vehicle> 400 ;;<Text>@@MEDVEHICLETEXT@@</Text> 401 ;;</Vehicle> 402 ;;<Route> 403 ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text> 404 ;;</Route> 405 ;;<Frequency> 406 ;;<Value>@@MEDFREQUENCYVALUE@@</Value> 407 ;;</Frequency> 408 ;;<Interval> 409 ;;<Value>@@MEDINTERVALVALUE@@</Value> 410 ;;<Units> 411 ;;<Unit>@@MEDINTERVALUNIT@@</Unit> 412 ;;</Units> 413 ;;</Interval> 414 ;;<Duration> 415 ;;<Value>@@MEDDURATIONVALUE@@</Value> 416 ;;<Units> 417 ;;<Unit>@@MEDDURATIONUNIT@@</Unit> 418 ;;</Units> 419 ;;</Duration> 420 ;;<Indication> 421 ;;<PRNFlag> 422 ;;<Text>@@MEDPRNFLAG@@</Text> 423 ;;</PRNFlag> 424 ;;<Problem> 425 ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID> 426 ;;<Type> 427 ;;<Text>@@MEDPROBLEMTYPETXT@@</Text> 428 ;;</Type> 429 ;;<Description> 430 ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text> 431 ;;<Code> 432 ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value> 433 ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem> 434 ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version> 435 ;;</Code> 436 ;;</Description> 437 ;;<Source> 438 ;;<Actor> 439 ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID> 440 ;;</Actor> 441 ;;</Source> 442 ;;</Problem> 443 ;;</Indication> 444 ;;<StopIndicator> 445 ;;<Text>@@MEDSTOPINDICATOR@@</Text> 446 ;;</StopIndicator> 447 ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier> 448 ;;<MultipleDirectionModifier> 449 ;;<Text>@@MEDMULDIRMOD@@</Text> 450 ;;</MultipleDirectionModifier> 451 ;;</Direction> 452 ;;</Directions> 453 ;;<PatientInstructions> 454 ;;<Instruction> 455 ;;<Text>@@MEDPTINSTRUCTIONS@@</Text> 456 ;;</Instruction> 457 ;;</PatientInstructions> 458 ;;<FullfillmentInstructions> 459 ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text> 460 ;;</FullfillmentInstructions> 461 ;;<Refills> 462 ;;<Refill> 463 ;;<Number>@@MEDRFNO@@</Number> 464 ;;</Refill> 465 ;;</Refills> 466 ;;</Medication> 467 ;;</Medications> 468 ;;<VitalSigns> 469 ;;<Result> 470 ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID> 471 ;;<DateTime> 472 ;;<Type> 473 ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text> 474 ;;</Type> 475 ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime> 476 ;;</DateTime> 477 ;;<Description> 478 ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text> 479 ;;</Description> 480 ;;<Source> 481 ;;<Actor> 482 ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID> 483 ;;</Actor> 484 ;;</Source> 485 ;;<Test> 486 ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID> 487 ;;<Type> 488 ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text> 489 ;;</Type> 490 ;;<Description> 491 ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text> 492 ;;<Code> 493 ;;<Value>@@VITALSIGNSDESCCODEVALUE@@</Value> 494 ;;<CodingSystem>@@VITALSIGNSDESCCODINGSYSTEM@@</CodingSystem> 495 ;;<Version>@@VITALSIGNSCODEVERSION@@</Version> 496 ;;</Code> 497 ;;</Description> 498 ;;<Source> 499 ;;<Actor> 500 ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID> 501 ;;</Actor> 502 ;;</Source> 503 ;;<TestResult> 504 ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value> 505 ;;<Units> 506 ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit> 507 ;;</Units> 508 ;;</TestResult> 509 ;;</Test> 510 ;;</Result> 511 ;;</VitalSigns> 512 ;;<Results> 513 ;;<Result> 514 ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID> 515 ;;<DateTime> 516 ;;<Type> 517 ;;<Text>Assessment Time</Text> 518 ;;</Type> 519 ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime> 520 ;;</DateTime> 521 ;;<Description> 522 ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text> 523 ;;<Code> 524 ;;<Value>@@RESULTCODE@@</Value> 525 ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem> 526 ;;</Code> 527 ;;</Description> 528 ;;<Status> 529 ;;<Text>@@RESULTSTATUS@@</Text> 530 ;;</Status> 531 ;;<Source> 532 ;;<Actor> 533 ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID> 534 ;;</Actor> 535 ;;</Source> 536 ;;<Test> 537 ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID> 538 ;;<DateTime> 539 ;;<Type> 540 ;;<Text>Assessment Time</Text> 541 ;;</Type> 542 ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime> 543 ;;</DateTime> 544 ;;<Description> 545 ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text> 546 ;;<Code> 547 ;;<Value>@@RESULTTESTCODEVALUE@@</Value> 548 ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem> 549 ;;</Code> 550 ;;</Description> 551 ;;<Status> 552 ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text> 553 ;;</Status> 554 ;;<Source> 555 ;;<Actor> 556 ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID> 557 ;;</Actor> 558 ;;</Source> 559 ;;<TestResult> 560 ;;<Value>@@RESULTTESTVALUE@@</Value> 561 ;;<Units> 562 ;;<Unit>@@RESULTTESTUNITS@@</Unit> 563 ;;</Units> 564 ;;</TestResult> 565 ;;<NormalResult> 566 ;;<Normal> 567 ;;<Description> 568 ;;<Text>@@RESULTTESTNORMALDESCTEXT@@</Text> 569 ;;</Description> 570 ;;<Source> 571 ;;<Actor> 572 ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID> 573 ;;</Actor> 574 ;;</Source> 575 ;;</Normal> 576 ;;</NormalResult> 577 ;;<Flag> 578 ;;<Text>@@RESULTTESTFLAG@@</Text> 579 ;;</Flag> 580 ;;</Test> 581 ;;</Result> 582 ;;</Results> 583 ;;<Procedures> 584 ;;<Procedure> 585 ;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID> 586 ;;<DateTime> 587 ;;<Type> 588 ;;<Text>@@PROCDATETEXT@@</Text> 589 ;;</Type> 590 ;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime> 591 ;;</DateTime> 592 ;;<Description> 593 ;;<Text>@@PROCDESCTEXT@@</Text> 594 ;;<ObjectAttribute> 595 ;;<Attribute>@@PROCDESCOBJATTR@@</Attribute> 596 ;;<AttributeValue> 597 ;;<Value>@@PROCDESCOBJATTRVAL@@</Value> 598 ;;<Code> 599 ;;<Value>@@PROCDESCOBJATTRCODE@@</Value> 600 ;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem> 601 ;;</Code> 602 ;;</AttributeValue> 603 ;;</ObjectAttribute> 604 ;;<Code> 605 ;;<Value>@@PROCCODE@@</Value> 606 ;;<CodingSystem>@@PROCCODESYS@@</CodingSystem> 607 ;;</Code> 608 ;;</Description> 609 ;;<Status> 610 ;;<Text>@@PROCSTATUS@@</Text> 611 ;;</Status> 612 ;;<Source> 613 ;;<Actor> 614 ;;<ActorID>@@PROCACTOROBJID@@</ActorID> 615 ;;</Actor> 616 ;;</Source> 617 ;;<InternalCCRLink> 618 ;;<LinkID>@@PROCLINKID@@</LinkID> 619 ;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship> 620 ;;</InternalCCRLink> 621 ;;</Procedure> 622 ;;</Procedures> 623 ;;<Encounters> 624 ;;<Encounter> 625 ;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID> 626 ;;<DateTime> 627 ;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime> 628 ;;</DateTime> 629 ;;<Type> 630 ;;<Text>@@ENCTYPETXT@@</Text> 631 ;;<Code> 632 ;;<Value>@@ENCTYPECODE@@</Value> 633 ;;<CodingSystem>@@ENCTYPECODESYS@@</CodingSystem> 634 ;;</Code> 635 ;;</Type> 636 ;;<Description> 637 ;;<Text>@@ENCDESCTXT@@</Text> 638 ;;<Code> 639 ;;<Value>@@ENCDESCCODE@@</Value> 640 ;;<CodingSystem>@@ENCDESCCODESYS@@</CodingSystem> 641 ;;</Code> 642 ;;</Description> 643 ;;<Location> 644 ;;<Actor> 645 ;;<ActorID>@@ENCLOCACTORID@@</ActorID> 646 ;;</Actor> 647 ;;</Location> 648 ;;<Practioner> 649 ;;<Actor> 650 ;;<ActorID>@@ENCPRVACTORID@@</ActorID> 651 ;;</Actor> 652 ;;</Practioner> 653 ;;<Indication> 654 ;;<Text>@@ENCINDTXT@@</Text> 655 ;;<Code> 656 ;;<Value>@@ENCINDCODE@@</Value> 657 ;;<CodingSystem>@@ENCINDCODESYS@@</CodingSystem> 658 ;;</Code> 659 ;;</Indication> 660 ;;<Source> 661 ;;<Actor> 662 ;;<ActorID>@@ENCACTORID@@</ActorID> 663 ;;</Actor> 664 ;;</Source> 665 ;;<CommentID>@@ENCCOMMENTID@@</CommentID> 666 ;;</Encounter> 667 ;;</Encounters> 668 ;;<HealthCareProviders> 669 ;;<Provider> 670 ;;<ActorID>AA0005</ActorID> 671 ;;<ActorRole> 672 ;;<Text>Primary Provider</Text> 673 ;;</ActorRole> 674 ;;</Provider> 675 ;;</HealthCareProviders> 676 ;;</Body> 677 ;;<Actors> 678 ;;<ACTOR-PATIENT> 679 ;;<Actor> 680 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 681 ;;<Person> 682 ;;<Name> 683 ;;<CurrentName> 684 ;;<Given>@@ACTORGIVENNAME@@</Given> 685 ;;<Middle>@@ACTORMIDDLENAME@@</Middle> 686 ;;<Family>@@ACTORFAMILYNAME@@</Family> 687 ;;</CurrentName> 688 ;;</Name> 689 ;;<DateOfBirth> 690 ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime> 691 ;;</DateOfBirth> 692 ;;<Gender> 693 ;;<Text>@@ACTORGENDER@@</Text> 694 ;;<Code> 695 ;;<Value>@@ACTORGENDERCODE@@</Value> 696 ;;<CodingSystem>HL7 AdministrativeGender</CodingSystem> 697 ;;</Code> 698 ;;</Gender> 699 ;;</Person> 700 ;;<IDs> 701 ;;<Type> 702 ;;<Text>@@ACTORSSNTEXT@@</Text> 703 ;;</Type> 704 ;;<ID>@@ACTORSSN@@</ID> 705 ;;<Source> 706 ;;<Actor> 707 ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID> 708 ;;</Actor> 709 ;;</Source> 710 ;;</IDs> 711 ;;<Address> 712 ;;<Type> 713 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 714 ;;</Type> 715 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 716 ;;<Line2>@@ACTORADDRESSLINE2@@</Line2> 717 ;;<City>@@ACTORADDRESSCITY@@</City> 718 ;;<State>@@ACTORADDRESSSTATE@@</State> 719 ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode> 720 ;;</Address> 721 ;;<Telephone> 722 ;;<Value>@@ACTORRESTEL@@</Value> 723 ;;<Type> 724 ;;<Text>@@ACTORRESTELTEXT@@</Text> 725 ;;</Type> 726 ;;</Telephone> 727 ;;<Telephone> 728 ;;<Value>@@ACTORWORKTEL@@</Value> 729 ;;<Type> 730 ;;<Text>@@ACTORWORKTELTEXT@@</Text> 731 ;;</Type> 732 ;;</Telephone> 733 ;;<Telephone> 734 ;;<Value>@@ACTORCELLTEL@@</Value> 735 ;;<Type> 736 ;;<Text>@@ACTORCELLTELTEXT@@</Text> 737 ;;</Type> 738 ;;</Telephone> 739 ;;<EMail> 740 ;;<Value>@@ACTOREMAIL@@</Value> 741 ;;</EMail> 742 ;;<Source> 743 ;;<Actor> 744 ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID> 745 ;;</Actor> 746 ;;</Source> 747 ;;</Actor> 748 ;;</ACTOR-PATIENT> 749 ;;<ACTOR-SYSTEM> 750 ;;<Actor> 751 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 752 ;;<InformationSystem> 753 ;;<Name>@@ACTORINFOSYSNAME@@</Name> 754 ;;<Version>@@ACTORINFOSYSVER@@</Version> 755 ;;</InformationSystem> 756 ;;<Source> 757 ;;<Actor> 758 ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID> 759 ;;</Actor> 760 ;;</Source> 761 ;;</Actor> 762 ;;</ACTOR-SYSTEM> 763 ;;<ACTOR-NOK> 764 ;;<Actor> 765 ;;<ActorObjectID>AA0003</ActorObjectID> 766 ;;<Person> 767 ;;<Name> 768 ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName> 769 ;;</Name> 770 ;;</Person> 771 ;;<Relation> 772 ;;<Text>@@ACTORRELATION@@</Text> 773 ;;</Relation> 774 ;;<Source> 775 ;;<Actor> 776 ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID> 777 ;;</Actor> 778 ;;</Source> 779 ;;</Actor> 780 ;;</ACTOR-NOK> 781 ;;<ACTOR-PROVIDER> 782 ;;<Actor> 783 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 784 ;;<Person> 785 ;;<Name> 786 ;;<CurrentName> 787 ;;<Given>@@ACTORGIVENNAME@@</Given> 788 ;;<Middle>@@ACTORMIDDLENAME@@</Middle> 789 ;;<Family>@@ACTORFAMILYNAME@@</Family> 790 ;;<Title>@@ACTORTITLE@@</Title> 791 ;;</CurrentName> 792 ;;</Name> 793 ;;</Person> 794 ;;<Specialty> 795 ;;<Text>@@ACTORSPECIALITY@@</Text> 796 ;;</Specialty> 797 ;;<Address> 798 ;;<Type> 799 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 800 ;;</Type> 801 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 802 ;;<City>@@ACTORADDRESSCITY@@</City> 803 ;;<State>@@ACTORADDRESSSTATE@@</State> 804 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode> 805 ;;</Address> 806 ;;<Telephone> 807 ;;<Value>@@ACTORTELEPHONE@@</Value> 808 ;;<Type> 809 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 810 ;;</Type> 811 ;;</Telephone> 812 ;;<Email> 813 ;;<Value>@@ACTOREMAIL@@</Value> 814 ;;</Email> 815 ;;<Source> 816 ;;<Actor> 817 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 818 ;;</Actor> 819 ;;</Source> 820 ;;<InternalCCRLink> 821 ;;<LinkID>@@ACTORORGLINK@@</LinkID> 822 ;;<LinkRelationship>representedOrganization</LinkRelationship> 823 ;;</InternalCCRLink> 824 ;;</Actor> 825 ;;</ACTOR-PROVIDER> 826 ;;<ACTOR-ORG> 827 ;;<Actor> 828 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 829 ;;<Organization> 830 ;;<Name>@@ORGANIZATIONNAME@@</Name> 831 ;;</Organization> 832 ;;<Address> 833 ;;<Type> 834 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 835 ;;</Type> 836 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 837 ;;<City>@@ACTORADDRESSCITY@@</City> 838 ;;<State>@@ACTORADDRESSSTATE@@</State> 839 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode> 840 ;;</Address> 841 ;;<Telephone> 842 ;;<Value>@@ACTORTELEPHONE@@</Value> 843 ;;<Type> 844 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 845 ;;</Type> 846 ;;</Telephone> 847 ;;<Source> 848 ;;<Actor> 849 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 850 ;;</Actor> 851 ;;</Source> 852 ;;</Actor> 853 ;;</ACTOR-ORG> 854 ;;</Actors> 855 ;;<Signatures> 856 ;;<CCRSignature> 857 ;;<SignatureObjectID>S0001</SignatureObjectID> 858 ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime> 859 ;;<Source> 860 ;;<ActorID>AA0001</ActorID> 861 ;;</Source> 862 ;;<Signature> 863 ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#"> 864 ;;<SignedInfo> 865 ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/> 866 ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/> 867 ;;<Reference URI=""> 868 ;;<Transforms> 869 ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/> 870 ;;</Transforms> 871 ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/> 872 ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue> 873 ;;</Reference> 874 ;;</SignedInfo> 875 ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue> 876 ;;<KeyInfo> 877 ;;<KeyValue> 878 ;;<RSAKeyValue> 879 ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus> 880 ;;<Exponent>AQAB</Exponent> 881 ;;</RSAKeyValue> 882 ;;</KeyValue> 883 ;;</KeyInfo> 884 ;;</Signature> 885 ;;</Signature> 886 ;;</CCRSignature> 887 ;;</Signatures> 888 ;;<Comments> 889 ;;<Comment> 890 ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID> 891 ;;<DateTime> 892 ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime> 893 ;;</DateTime> 894 ;;<Description> 895 ;;<Text> 896 ;;</Text> 897 ;;</Description> 898 ;;<Source> 899 ;;<Actor> 900 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 901 ;;</Actor> 902 ;;</Source> 903 ;;</Comment> 904 ;;</Comments> 905 ;;</ContinuityOfCareRecord> 906 ;</TEMPLATE> -
ccr/branches/ohum/p/C0CCMT.m
r1342 r1428 1 C0CCMT 2 ;;1.0;C0C;;May 21, 2010;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXTRACT(NOTEXML,DFN,NOTEOUT) 25 26 27 28 29 30 31 32 MAP(NOTEXML,C0CNTE,NOTEOUT) 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 CLEAN(INARY) 60 61 62 63 64 65 66 1 C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10 2 ;;1.2;C0C;;May 11, 2012;Build 46 3 ;Copyright 2010 George Lilly, University of Minnesota and others. 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 W "NO ENTRY FROM TOP",! 22 Q 23 ; 24 EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO XML TEMPLATE 25 ; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 26 ; 27 D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES 28 ;I '$D(@C0CNTE) Q ; NO NOTES AVAILABLE 29 D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES 30 Q 31 ; 32 MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML 33 ; 34 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE 35 K @ZTEMP 36 N ZBLD 37 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA 38 D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE 39 N ZINNER 40 D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE 41 N ZTMP,ZVAR,ZI 42 S ZI="" 43 F S ZI=$O(@C0CNTE@(ZI)) Q:ZI="" D ;FOR EACH NOTE 44 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML 45 . S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES 46 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE 47 . N ZNOTE,ZN 48 . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED 49 . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD 50 . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE 51 . D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text") 52 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD 53 D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0)) 54 N ZZTMP 55 D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML 56 K @ZTEMP,@ZBLD,@C0CNTE 57 Q 58 ; 59 CLEAN(INARY) ; INARY IS PASSED BY NAME 60 ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY 61 N ZI,ZJ S ZI="" 62 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; 63 . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS 64 . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS 65 Q 66 ; -
ccr/branches/ohum/p/C0CCPT.m
r1342 r1428 1 C0CCPT ;;BSL;RETURN CPT DATA; 2 ;Sequence Managers Software GPL;;;;;Build 2 3 ;Copied into C0C namespace from SQMCPT with permission from 4 ;Brian Lord - and with our thanks. gpl 01/20/2010 5 ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES 6 ;DFN=PATIENT IEN 7 ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD) 8 ;ENDDT=END DATE IN 3100101 FORMAT 9 ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE 10 ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 11 ;ALL INCLUSIVE IN THAT DIRECTION 12 ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN) 13 ;BUILD INTO NOTE(Y)="" 14 S U="^",X="" 15 F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D 16 . S Y="" 17 . F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D 18 .. S NOTE(Y)="" 19 ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE 20 ;GET DATE OF NOTE 21 ;RUT 3120109 Changing DATE in FILMAN's FORMAT 22 ;;OHUM/RUT 3111228 Date Range for Notes 23 ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X 24 N FLAGS1,FLAGS2 25 S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1) 26 S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2) 27 ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART") 28 ;;OHUM/RUT 29 ;RUT 30 S Z="" 31 F S Z=$O(NOTE(Z)) Q:Z="" D 32 . S DT=$P(^TIU(8925,Z,0),U,7) 33 . I $G(STDT)]"" D 34 .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED 35 . I $G(ENDDT)]"" D 36 .. I ENDDT<DT S NOTE(Z)="D" 37 . I NOTE(Z)="D" K NOTE(Z) 38 D VISIT 39 Q 40 VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT 41 S ILST=1,X0="",X12="",VISIT="",LST="",X811="" 42 S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D 43 . S X0=^TIU(8925,IEN,0),X12=$G(^(12)) 44 . S VISIT=$P(X12,U,7) 45 . I 'VISIT S VISIT=$P(X0,U,3) 46 . K ^TMP("PXKENC",$J) 47 . Q:VISIT=""!(VISIT'>0) 48 . D ENCEVENT^PXKENC(VISIT,1) 49 . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q 50 . S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D 51 .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0) 52 .. ;Q:$P(X0,U,4)'="P" 53 .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U) 54 .. S PRIM=($P(X0,U,4)="P") 55 .. S ILST=ILST+1 56 .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM 57 .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM 58 . S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D 59 .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811)) 60 .. S CODE=$P(X0,U) 61 .. S:CODE CODE=$P(^ICD9(CODE,0),U) 62 .. S CAT=$P(X802,U) 63 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 64 .. S NARR=$P(X0,U,4) 65 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 66 .. S PRIM=($P(X0,U,12)="P") 67 .. S PRV=$P(X12,U,4) 68 .. S ILST=ILST+1 69 .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV 70 .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV 71 . S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D 72 .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811)) 73 .. ;S CODE=$P(X0,U) 74 .. S CODE=$O(^ICPT("B",$P(X0,U),0)) 75 .. S:CODE CODE=$P(^ICPT(CODE,0),U) 76 .. S CAT=$P(X802,U) 77 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 78 .. S NARR=$P(X0,U,4) 79 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 80 .. S QTY=$P(X0,U,16) 81 .. S PRV=$P(X12,U,4) 82 .. S MCNT=0,MIDX=0,MODS="" 83 .. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D 84 ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0)) 85 ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN 86 .. I +MCNT S MODS=MCNT_MODS 87 .. S ILST=ILST+1 88 .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 89 .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 90 . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".") 91 . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10 92 . I $G(TXT)=1 D GETNOTE(IEN) 93 Q 94 GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT 95 ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT" 96 Q:'$D(VISIT(IEN,"CPT")) 97 S TXTCNT=0 98 F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D 99 . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0) 100 Q 1 C0CCPT ;;BSL;RETURN CPT DATA; 2 ;;1.2;C0C;;May 11, 2012;Build 46 3 ;Sequence Managers Software GPL;;;;;Build 2 4 ;Copied into C0C namespace from SQMCPT with permission from 5 ;Brian Lord - and with our thanks. gpl 01/20/2010 6 ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES 7 ;DFN=PATIENT IEN 8 ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD) 9 ;ENDDT=END DATE IN 3100101 FORMAT 10 ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE 11 ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 12 ;ALL INCLUSIVE IN THAT DIRECTION 13 ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN) 14 ;BUILD INTO NOTE(Y)="" 15 S U="^",X="" 16 F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D 17 . S Y="" 18 . F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D 19 .. S NOTE(Y)="" 20 ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE 21 ;GET DATE OF NOTE 22 ;RUT 3120109 Changing DATE in FILMAN's FORMAT 23 ;;OHUM/RUT 3111228 Date Range for Notes 24 ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X 25 N FLAGS1,FLAGS2 26 S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1) 27 S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2) 28 ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART") 29 ;;OHUM/RUT 30 ;RUT 31 S Z="" 32 F S Z=$O(NOTE(Z)) Q:Z="" D 33 . S DT=$P(^TIU(8925,Z,0),U,7) 34 . I $G(STDT)]"" D 35 .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED 36 . I $G(ENDDT)]"" D 37 .. I ENDDT<DT S NOTE(Z)="D" 38 . I NOTE(Z)="D" K NOTE(Z) 39 D VISIT 40 Q 41 VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT 42 S ILST=1,X0="",X12="",VISIT="",LST="",X811="" 43 S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D 44 . S X0=^TIU(8925,IEN,0),X12=$G(^(12)) 45 . S VISIT=$P(X12,U,7) 46 . I 'VISIT S VISIT=$P(X0,U,3) 47 . K ^TMP("PXKENC",$J) 48 . Q:VISIT=""!(VISIT'>0) 49 . D ENCEVENT^PXKENC(VISIT,1) 50 . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q 51 . S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D 52 .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0) 53 .. ;Q:$P(X0,U,4)'="P" 54 .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U) 55 .. S PRIM=($P(X0,U,4)="P") 56 .. S ILST=ILST+1 57 .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM 58 .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM 59 . S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D 60 .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811)) 61 .. S CODE=$P(X0,U) 62 .. S:CODE CODE=$P(^ICD9(CODE,0),U) 63 .. S CAT=$P(X802,U) 64 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 65 .. S NARR=$P(X0,U,4) 66 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 67 .. S PRIM=($P(X0,U,12)="P") 68 .. S PRV=$P(X12,U,4) 69 .. S ILST=ILST+1 70 .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV 71 .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV 72 . S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D 73 .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811)) 74 .. ;S CODE=$P(X0,U) 75 .. S CODE=$O(^ICPT("B",$P(X0,U),0)) 76 .. S:CODE CODE=$P(^ICPT(CODE,0),U) 77 .. S CAT=$P(X802,U) 78 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 79 .. S NARR=$P(X0,U,4) 80 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 81 .. S QTY=$P(X0,U,16) 82 .. S PRV=$P(X12,U,4) 83 .. S MCNT=0,MIDX=0,MODS="" 84 .. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D 85 ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0)) 86 ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN 87 .. I +MCNT S MODS=MCNT_MODS 88 .. S ILST=ILST+1 89 .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 90 .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 91 . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".") 92 . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10 93 . I $G(TXT)=1 D GETNOTE(IEN) 94 Q 95 GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT 96 ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT" 97 Q:'$D(VISIT(IEN,"CPT")) 98 S TXTCNT=0 99 F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D 100 . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0) 101 Q -
ccr/branches/ohum/p/C0CDIC.m
r1342 r1428 1 C0CDIC 2 ;;0.1;CCDCCR;nopatch;noreleasedate;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 DIC2CSV 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 GVARS(C0CVARS,C0CT) 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 GXPATH(C0CPVARS,C0CPT) 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 HASHV 86 87 88 89 90 91 92 93 SORTV 94 95 96 97 98 99 100 101 102 103 104 LOAD 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 INIT 121 122 123 124 125 126 127 128 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 SETFDA(C0CSN,C0CSV) 183 184 185 186 187 188 189 190 191 192 ZFILE(ZFN,ZTAB) 193 194 195 196 197 ZFIELD(ZFN,ZTAB) 198 199 200 201 202 ZVALUE(ZFN,ZTAB) 203 204 205 206 207 1 C0CDIC ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08 2 ;;1.2;C0C;;May 11, 2012;Build 46 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "This is the CCR Dictionary Utility Library ",! 21 W ! 22 Q 23 ; 24 DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE 25 ; 26 N ZI 27 S ZI="" 28 S G1=$NA(^TMP($J,"C0CCSV",1)) 29 S G1A=$NA(@G1@("V")) 30 S G2=$NA(^TMP($J,"C0CCSV",2)) 31 D GETN2^C0CRNF(G1,170) ; GET THE MATRIX 32 F S ZI=$O(@G1A@(ZI)) Q:ZI="" D ;FOR EACH ROW IN THE MATRIX 33 . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D ; 34 . . W @G1A@(ZI,"MAPPING METHOD",1),! 35 . . ;K @G1A@(ZI,"MAPPING METHOD") 36 . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1)) 37 D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE 38 K @G1 39 D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv") 40 K @G2 41 Q 42 ; 43 GVARS(C0CVARS,C0CT) ; Get the CCR variables from the CCR template 44 ; and return them in C0CVARS, which is passed by name 45 ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE 46 ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE 47 ; C0CT IS RETURNED AS THE CCR TEMPLATE 48 N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS 49 D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE 50 D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS 51 N C0CI,C0CX 52 S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT 53 F C0CI=1:1:C0CTVARS(0) D ; FOR EVERY LINE IN THE ARRAY 54 . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL 55 . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER 56 ;D PARY^GPLXPATH("C0CVARS") 57 Q 58 ; 59 GXPATH(C0CPVARS,C0CPT) ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES 60 ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS 61 ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE 62 ; BOTH ARE PASSED BY NAME 63 ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM 64 ; C0CPVARS(0) IS NUMBER OF VARIABLES 65 ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE 66 D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS 67 ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER 68 D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS 69 ; NOW GO GET THE XPATH INDEXES 70 D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY 71 S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS 72 F S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI="" D ; VISIT EVERY LINE 73 . I +C0CI'=0 Q ; SKIP EVERYTHING BUT THE XPATH INDEX 74 . I C0CI=0 Q ; SKIP THE ZERO NODE 75 . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y 76 . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER 77 . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER 78 . I C0CY=C0CZ D ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE) 79 . . ; W "FOUND ",C0CI,! 80 . . I $D(C0CTVARS(C0CY)) D ; IF THERE IS A VARIABLE THERE 81 . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR 82 D SORTV ; SORT THE ARRAY BY LINE NUMBER 83 Q 84 ; 85 HASHV ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH 86 ;N C0CI,C0CTVARS,C0CX,C0CY 87 F C0CI=1:1:@C0CPVARS@(0) D ; FOR THE ENTIRE ARRAY 88 . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER 89 . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME 90 . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER 91 Q 92 ; 93 SORTV ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER 94 ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY 95 S C0CI="" ; 96 F S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI="" D ; BY LINE NUMBER 97 . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME 98 . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE 99 . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY 100 K @C0CPVARS 101 M @C0CPVARS=C0C2 102 Q 103 ; 104 LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170 105 ; INITIAL LOAD OF THE CCR DICTIONARY 106 ; 107 N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI 108 S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY 109 D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY 110 ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD 111 D PARY^GPLXPATH("C0CARY") ;TEST 112 F C0CI=1:1:C0CARY(0) D ; LOAD EACH VARIABLE 113 . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME 114 . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH 115 . D UPDATE^DIE("","C0CFDA") 116 . I $D(^TMP("DIERR",$J)) U $P BREAK 117 . W "LOADING:",C0CI," ",C0CARY(C0CI),! 118 Q 119 ; 120 INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES 121 ; 122 ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx, 123 ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY 124 ;G1("CODING")="170^8" 125 ;G1("DATA ELEMENT")="170^7" 126 ;G1("DESCRIPTION")="170^3" 127 ;G1("ID")="170^1" 128 ;G1("M","170^8","CODING")="170.08^.01" 129 ;G1("MAPPING METHOD")="170.08^1" 130 ;G1("SECTION")="170^10" 131 ;G1("SOURCE")="170^4" 132 ;G1("STATUS")="170^9" 133 ;G1("TYPE")="170^6" 134 ;G1("VARIABLE")="170^.01" 135 ;G1("XPATH")="170^2" 136 ; 137 N C0CZA,C0CZX,C0CN,C0CSTAT 138 S C0CZX=0 139 S C0CSTAT=0 ; INIT STATUS SET FLAG 140 F S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0 D ; FOR EACH DICT ENTRY 141 . ;W C0CZX,! 142 . K C0CA,C0CN ; CLEAR OUT THE LAST ONE 143 . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH 144 . ;ZWR C0CA B ; 145 . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE 146 . W "VARIABLE: ",C0CN,! 147 . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ; 148 . I $E(C0CN,1,6)="SOCIAL" D ; 149 . . D SETFDA("SECTION","SOC") ; 150 . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED 151 . . S C0CSTAT=1 152 . I $E(C0CN,1,6)="FAMILY" D ; 153 . . D SETFDA("SECTION","FAM") ; 154 . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED 155 . . S C0CSTAT=1 156 . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS 157 . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS") 158 . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS") 159 . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS") 160 . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST") 161 . E I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS") 162 . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES 163 . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION 164 . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM 165 . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N 166 . I $$ZVALUE("XPATH")["/Medication/Directions/" D ; MEDS DIRECTIONS VAR 167 . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS 168 . E I $$ZVALUE("XPATH")["/Medications/Medication/" D ; ALL OTHER MEDS 169 . . D SETFDA("SECTION","MEDS") ; A MEDS VAR 170 . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS 171 . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE 172 . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),! 173 . ;ZWR C0CFDA 174 . I $D(C0CFDA) D ; WE HAVE CHANGES ON THIS VARIABLE 175 . . ;ZWR C0CFDA 176 . . D UPDATE^DIE("","C0CFDA(C0CZX)") 177 . . I $D(^TMP("DIERR",$J)) U $P BREAK 178 . . D CLEAN^DILF ; CLEAN UP 179 . ;ZWR C0CFDA 180 Q 181 ; 182 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 183 ; TO SET TO VALUE C0CSV. 184 ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 185 ; C0CSN,C0CSV ARE PASSED BY VALUE 186 ; 187 N C0CSI,C0CSJ 188 S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER 189 S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER 190 S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV 191 Q 192 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 193 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 194 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 195 I '$D(ZTAB) S ZTAB="C0CA" 196 Q $P(@ZTAB@(ZFN),"^",1) 197 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 198 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 199 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 200 I '$D(ZTAB) S ZTAB="C0CA" 201 Q $P(@ZTAB@(ZFN),"^",2) 202 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 203 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 204 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 205 I '$D(ZTAB) S ZTAB="C0CA" 206 Q $P(@ZTAB@(ZFN),"^",3) 207 ; -
ccr/branches/ohum/p/C0CDOM.m
r1342 r1428 1 C0CDOM 2 ;;0.1;C0C;nopatch;noreleasedate;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) 23 24 25 26 27 28 29 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 ADDNARY(ZXP,ZVALUE) 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 PARSE(INXML,INDOC) 85 86 87 88 89 90 ISMULT(ZOID) 91 92 93 94 95 96 97 FIRST(ZOID) 98 99 100 PARENT(ZOID) 101 102 103 ATT(RTN,NODE) 104 105 106 107 108 109 TAG(ZOID) 110 111 112 113 114 115 116 117 118 NXTSIB(ZOID) 119 120 121 DATA(ZT,ZOID) 122 123 124 125 126 127 128 OUTXML(ZRTN,INID,NO1ST) 129 130 131 132 133 134 135 136 137 138 139 NDOUT(ZOID) 140 141 142 143 144 145 146 147 148 149 150 151 152 153 WNHIN(ZDFN) 154 155 156 157 158 159 160 161 NARY2XML(ZGOUT,ZGIN) 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 DOMI(INARY,HANDLE,PARENT) 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 MAJOR(ZARY) 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 EXPAND(ZZOUT,ZZIN) 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 NEWDOM() 312 313 314 315 316 317 318 319 1 C0CDOM ; GPL - DOM PROCESSING ROUTINES ;6/6/11 17:05 2 ;;1.2;C0C;;May 11, 2012;Build 46 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 Q 21 ; 22 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 23 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 24 ; THE XPATH ARRAY XPARY, PASSED BY NAME 25 ; ZOID IS THE STARTING OID 26 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 27 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 28 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 29 I $G(ZREDUX)="" S ZREDUX="" 30 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 31 N NEWNUM S NEWNUM="" 32 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 33 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 34 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 35 . N GT S GT=$P(NEWPATH,ZREDUX,2) 36 . I GT'="" S NEWPATH=GT 37 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 38 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 39 I $D(GA) D ; PROCESS THE ATTRIBUTES 40 . N ZI S ZI="" 41 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 42 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE 43 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 44 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 45 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 46 I $D(GD(2)) D ; 47 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 48 E I $D(GD(1)) D ; 49 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 50 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 51 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 52 I ZFRST'=0 D ; THERE IS A CHILD 53 . N ZNUM 54 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 55 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 56 N GNXT S GNXT=$$NXTSIB(ZOID) 57 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 58 I GNXT'=0 D ; 59 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 60 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 61 . . N ZNUM S ZNUM=1 ; 62 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 63 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 64 Q 65 ; 66 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 67 ; 68 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES 69 ; 70 N ZZI,ZZJ,ZZN 71 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 72 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 73 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 74 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 75 I ZZI'["]" D ; A SINGLETON 76 . S ZZN=1 77 E D ; THERE IS AN [x] OCCURANCE 78 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 79 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 80 I ZZJ'="" D ; TIME TO ADD THE VALUE 81 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 82 Q 83 ; 84 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 85 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 86 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 87 ;Q $$EN^MXMLDOM(INXML) 88 Q $$EN^MXMLDOM(INXML,"W") 89 ; 90 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 91 N ZN 92 ;I $$TAG(ZOID)["entry" B 93 S ZN=$$NXTSIB(ZOID) 94 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 95 Q 0 96 ; 97 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 98 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 99 ; 100 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 101 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 102 ; 103 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 104 S HANDLE=C0CDOCID 105 K @RTN 106 D GETTXT^MXMLDOM("A") 107 Q 108 ; 109 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 110 ;I ZOID=149 B ;GPLTEST 111 N X,Y 112 S Y="" 113 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 114 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 115 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 116 Q Y 117 ; 118 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 119 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 120 ; 121 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 122 ;N ZT,ZN S ZT="" 123 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 124 ;Q $G(@C0CDOM@(ZOID,"T",1)) 125 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 126 Q 127 ; 128 OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 129 ; 130 S C0CDOCID=INID 131 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation 132 D START^C0CMXMLB($$TAG(1),,"G",NO1ST) 133 D NDOUT($$FIRST(1)) 134 D END^C0CMXMLB ;END THE DOCUMENT 135 M @ZRTN=^TMP("MXMLBLD",$J) 136 K ^TMP("MXMLBLD",$J) 137 Q 138 ; 139 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 140 N ZI S ZI=$$FIRST(ZOID) 141 I ZI'=0 D ; THERE IS A CHILD 142 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 143 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN 144 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 145 . ;W "DOING",ZOID,! 146 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 147 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 148 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 149 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 150 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 151 Q 152 ; 153 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 154 ; 155 N GN,GN2 156 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 157 S GN2=$NA(@GN@(1)) 158 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 159 Q 160 ; 161 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY 162 ; ZGOUT AND ZGIN ARE PASSED BY NAME 163 N C0CDOCID 164