Changeset 1204
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (14 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 added
- 44 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) (2 diffs)
-
C0CDOM.m (modified) (6 diffs)
-
C0CDPT.m (modified) (1 diff)
-
C0CENC.m (modified) (1 diff)
-
C0CEVC.m (added)
-
C0CEWD.m (modified) (1 diff)
-
C0CFM1.m (modified) (1 diff)
-
C0CFM2.m (modified) (1 diff)
-
C0CIM2.m (modified) (1 diff)
-
C0CIMMU.m (modified) (1 diff)
-
C0CIN.m (modified) (1 diff)
-
C0CLA7Q.m (modified) (1 diff)
-
C0CLABS.m (modified) (1 diff)
-
C0CMAIL2.m (added)
-
C0CMED.m (modified) (1 diff)
-
C0CMED1.m (modified) (1 diff)
-
C0CMED2.m (modified) (1 diff)
-
C0CMED3.m (modified) (1 diff)
-
C0CMIME.m (modified) (11 diffs)
-
C0CMXML.m (modified) (1 diff)
-
C0CMXMLB.m (modified) (2 diffs)
-
C0CMXP.m (modified) (1 diff)
-
C0CNHIN.m (modified) (4 diffs)
-
C0CNMED4.m (added)
-
C0CPARMS.m (modified) (1 diff)
-
C0CPROBS.m (modified) (1 diff)
-
C0CPROC.m (modified) (1 diff)
-
C0CRIMA.m (modified) (1 diff)
-
C0CRNF.m (modified) (1 diff)
-
C0CRXN.m (modified) (1 diff)
-
C0CSOAP.m (modified) (1 diff)
-
C0CSUB1.m (modified) (1 diff)
-
C0CSYS.m (modified) (1 diff)
-
C0CUNIT.m (modified) (1 diff)
-
C0CUTIL.m (modified) (1 diff)
-
C0CVA200.m (modified) (1 diff)
-
C0CVIT2.m (modified) (1 diff)
-
C0CXPAT0.m (modified) (1 diff)
-
C0CXPATH.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CACTOR.m
r770 r1204 1 C0CACTOR 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 EXTRACT(IPXML,ALST,AXML) 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 PATIENT(INXML,AIEN,AOID,OUTXML) 86 87 88 89 90 91 92 93 94 95 96 97 98 99 DEIDENT(GPL,ZDFN) 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 PEXTRACT(AMAP,AIEN,AOID) 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 MAP(INXML,AMAP,OUTXML) 185 186 187 188 SYSTEM(INXML,AIEN,AOID,OUTXML) 189 190 191 192 193 194 195 196 197 198 199 200 NOK(INXML,AIEN,AOID,OUTXML) 201 202 203 204 205 206 207 208 209 210 211 212 213 ORG(INXML,AIEN,AOID,OUTXML) 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 PROVIDER(INXML,AIEN,AOID,OUTXML) 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 1 C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ; This program is free software; you can redistribute it and/or modify 8 ; it under the terms of the GNU General Public License as published by 9 ; the Free Software Foundation; either version 2 of the License, or 10 ; (at your option) any later version. 11 ; 12 ; This program is distributed in the hope that it will be useful, 13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ; GNU General Public License for more details. 16 ; 17 ; You should have received a copy of the GNU General Public License along 18 ; with this program; if not, write to the Free Software Foundation, Inc., 19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 ; PROCESS THE ACTORS SECTION OF THE CCR 22 ; 23 ; ===Revision History=== 24 ; 0.1 Initial Writing of Skeleton--GPL 25 ; 0.2 Patient Data Extraction--SMH 26 ; 0.3 Information System Info Extraction--SMH 27 ; 0.4 Patient data rouine refactored; adjustments here--SMH 28 ; 29 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE 30 ; IPXML is the Input Actor Template into which we substitute values 31 ; This is straight XML. Values to be substituted are in @@VAL@@ format. 32 ; ALST is the actor list global generated by ACTLST^C0CCCR and has format: 33 ; ^TMP(7542,1,"ACTORS",0)=Count 34 ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN" 35 ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM" 36 ; AXML is the output arrary, to contain XML. 37 ; 38 N I,J,AMAP,AOID,ATYP,AIEN 39 D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML 40 D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES 41 I DEBUG W "PROCESSING ACTORS ",! 42 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST 43 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR 44 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID 45 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE 46 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER 47 . I AIEN="" D Q ; IEN CAN'T BE NULL 48 . . W "WARING NUL ACTOR: ",ATYP,! 49 . I ATYP="" Q ; NOT A VALID ACTOR 50 . ; 51 . I DEBUG W AOID_" "_ATYP_" "_AIEN,! 52 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE 53 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") 54 . . D PATIENT("ATMP",AIEN,AOID,"ATMP2") 55 . ; 56 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE 57 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") 58 . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2") 59 . ; 60 . I ATYP="NOK" D ; NOK ACTOR TYPE 61 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") 62 . . D NOK("ATMP",AIEN,AOID,"ATMP2") 63 . ; 64 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE 65 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") 66 . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2") 67 . ; 68 . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE 69 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") 70 . . D ORG("ATMP",AIEN,AOID,"ATMP2") 71 . ; 72 . W "PROCESSING:",ATYP," ",AIEN,! 73 . ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE 74 . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT 75 . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE 76 ; 77 N ACTTMP 78 D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS 79 I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS - 80 . ; STRINGS MARKED AS @@X@@ 81 . W "ACTORS Missing list: ",! 82 . F I=1:1:ACTTMP(0) W ACTTMP(I),! 83 Q 84 ; 85 PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR 86 I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! 87 ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE 88 ; CODE REUSABLE FROM ERX 89 N AMAP 90 S AMAP=$NA(^TMP($J,"AMAP")) 91 K @AMAP 92 D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR 93 I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1 94 I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR 95 D MAP(INXML,AMAP,OUTXML) ;MAP TO XML 96 K @AMAP ; CLEAN UP BEHIND US 97 Q 98 ; 99 DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR 100 S @GPL@("ACTORADDRESSCITY")="ALTON" 101 S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane" 102 S @GPL@("ACTORADDRESSLINE2")="" 103 S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN 104 S @GPL@("ACTORADDRESSSTATE")="KANSAS" 105 S @GPL@("ACTORADDRESSTYPE")="Home" 106 S @GPL@("ACTORADDRESSZIPCODE")=67623 107 S @GPL@("ACTORCELLTEL")="" 108 S @GPL@("ACTORCELLTELTEXT")="" 109 S @GPL@("ACTORDATEOFBIRTH")="1957-12-25" 110 S @GPL@("ACTOREMAIL")="" 111 S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN 112 ;S @GPL@("ACTORGENDER")="MALE" 113 S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN 114 S @GPL@("ACTORIEN")=2 115 S @GPL@("ACTORMIDDLENAME")="TWO" 116 S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN 117 S @GPL@("ACTORRESTEL")="888-555-1212" 118 S @GPL@("ACTORRESTELTEXT")="Residential Telephone" 119 S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1" 120 S @GPL@("ACTORSSN")="769122557P" 121 S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN 122 S @GPL@("ACTORSSNTEXT")="SSN" 123 S @GPL@("ACTORSUFFIXNAME")="" 124 S @GPL@("ACTORWORKTEL")="888-121-1212" 125 S @GPL@("ACTORWORKTELTEXT")="Work Telephone" 126 Q 127 ; 128 PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME 129 N ZX 130 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 131 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN) 132 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN) 133 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN) 134 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN) 135 S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2) 136 S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1) 137 S @AMAP@("ACTORSSN")="" 138 S @AMAP@("ACTORSSNTEXT")="" 139 S @AMAP@("ACTORSSNSOURCEID")="" 140 S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA 141 X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS 142 I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL 143 I $G(MRN)'="" D ; IF MRN IS PRESENT 144 . S @AMAP@("ACTORSSN")=MRN 145 . S @AMAP@("ACTORSSNTEXT")="MRN" 146 . S @AMAP@("ACTORSSNSOURCEID")=AOID 147 E D ; NO MRN, USE SSN 148 . S ZX=$$SSN^C0CDPT(AIEN) 149 . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD 150 . . S @AMAP@("ACTORSSN")=ZX 151 . . S @AMAP@("ACTORSSNTEXT")="SSN" 152 . . S @AMAP@("ACTORSSNSOURCEID")=AOID 153 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN) 154 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN) 155 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN) 156 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN) 157 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN) 158 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN) 159 S @AMAP@("ACTORRESTEL")="" 160 S @AMAP@("ACTORRESTELTEXT")="" 161 S ZX=$$RESTEL^C0CDPT(AIEN) 162 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 163 . S @AMAP@("ACTORRESTEL")=ZX 164 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone" 165 S @AMAP@("ACTORWORKTEL")="" 166 S @AMAP@("ACTORWORKTELTEXT")="" 167 S ZX=$$WORKTEL^C0CDPT(AIEN) 168 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 169 . S @AMAP@("ACTORWORKTEL")=ZX 170 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone" 171 S @AMAP@("ACTORCELLTEL")="" 172 S @AMAP@("ACTORCELLTELTEXT")="" 173 S ZX=$$CELLTEL^C0CDPT(AIEN) 174 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD 175 . S @AMAP@("ACTORCELLTEL")=ZX 176 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone" 177 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN) 178 S @AMAP@("ACTORADDRESSSOURCEID")=AOID 179 S @AMAP@("ACTORIEN")=AIEN 180 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX 181 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 182 Q 183 ; 184 MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML 185 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 186 Q 187 ; 188 SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR 189 ; 190 ; N AMAP 191 S AMAP=$NA(^TMP($J,"AMAP")) 192 K @AMAP 193 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 194 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS 195 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS 196 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID 197 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 198 Q 199 ; 200 NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR 201 ; 202 ; N AMAP 203 S AMAP=$NA(^TMP($J,"AMAP")) 204 K @AMAP 205 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 206 S @AMAP@("ACTORDISPLAYNAME")="" 207 S @AMAP@("ACTORRELATION")="" 208 S @AMAP@("ACTORRELATIONSOURCEID")="" 209 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 210 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 211 Q 212 ; 213 ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR 214 ; 215 N AMAP,ZIEN,ZSITE 216 S AMAP=$NA(^TMP($J,"AMAP")) 217 K @AMAP 218 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 219 S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE 220 S ZIEN=$P(ZSITE,"^",1) 221 S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2) 222 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" 223 S @AMAP@("ACTORADDRESSTYPE")="Office" 224 S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01) 225 S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02) 226 S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03) 227 S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02) 228 S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04) 229 S @AMAP@("ACTORTELEPHONE")="" 230 S @AMAP@("ACTORTELEPHONETYPE")="" 231 S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03) 232 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE 233 . S @AMAP@("ACTORTELEPHONE")=ZX 234 . S @AMAP@("ACTORTELEPHONETYPE")="Office" 235 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 236 K @AMAP 237 Q 238 ; 239 PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR 240 ; 241 ; N AMAP 242 S AMAP=$NA(^TMP($J,"AMAP")) 243 K @AMAP 244 I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN) 245 . W "WARNING - MISSING PROVIDER: ",AIEN,! 246 . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT 247 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 248 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN) 249 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN) 250 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN) 251 S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN) 252 S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1) 253 S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2) 254 S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3) 255 S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN) 256 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN) 257 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN) 258 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN) 259 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN) 260 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN) 261 S @AMAP@("ACTORTELEPHONE")="" 262 S @AMAP@("ACTORTELEPHONETYPE")="" 263 S ZX=$$TEL^C0CVA200(AIEN) 264 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE 265 . S @AMAP@("ACTORTELEPHONE")=ZX 266 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN) 267 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN) 268 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1" 269 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 270 S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1" 271 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 272 Q 273 ; -
ccr/trunk/p/C0CALERT.m
r666 r1204 1 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 2 ;;1.0;C0C;;May 19, 2009; 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":"418634005",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 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID 84 . I ACVUID'="" D ; IF VUID IS NOT NULL 85 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID" 86 . E D ; IF REACTANT CODE VALUE IS NULL 87 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS 88 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ; 89 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,! 90 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="" 91 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="" 92 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW 93 . N ARTMP,ARIEN,ARDES,ARVUID 94 . S (ARTMP,ARDES,ARVUID)="" 95 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS 96 . . S ARTMP=@ALTG@(ALTTMP,"S",1) 97 . . W "REACTION:",ARTMP,! 98 . . S ARIEN=$P(ARTMP,";",2) 99 . . S ARDES=$P(ARTMP,";",1) 100 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID") 101 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES 102 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL 103 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID 104 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID" 105 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM 106 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="" 107 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="" 108 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) 109 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION 110 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 111 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME 112 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") 113 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT") 114 . K @ALTARYTMP 115 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) 116 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) 117 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP) 118 . S ALTCNT=ALTCNT+1 119 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS 120 Q 121 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 122 ; INGLB IS OF THE FORM: PSNDF(50.6, 123 ; RETURN 50.6 124 Q $P($P(INGLB,"(",2),",",1) ; 1 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 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 . I ACVUID'="" D ; IF VUID IS NOT NULL 85 . . S ZC=$$CODE^C0CUTIL(ACVUID) 86 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 87 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 88 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 89 . E D ; IF REACTANT CODE VALUE IS NULL 90 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS 91 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ; 92 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,! 93 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="" 94 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="" 95 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD 96 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS 97 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD 98 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD 99 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW 100 . N ARTMP,ARIEN,ARDES,ARVUID 101 . S (ARTMP,ARDES,ARVUID)="" 102 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS 103 . . S ARTMP=@ALTG@(ALTTMP,"S",1) 104 . . W "REACTION:",ARTMP,! 105 . . S ARIEN=$P(ARTMP,";",2) 106 . . S ARDES=$P(ARTMP,";",1) 107 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID") 108 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES 109 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL 110 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID 111 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID" 112 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM 113 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="" 114 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="" 115 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) 116 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION 117 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 118 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME 119 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") 120 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT") 121 . K @ALTARYTMP 122 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) 123 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) 124 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP) 125 . S ALTCNT=ALTCNT+1 126 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS 127 Q 128 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 129 ; INGLB IS OF THE FORM: PSNDF(50.6, 130 ; RETURN 50.6 131 Q $P($P(INGLB,"(",2),",",1) ; -
ccr/trunk/p/C0CBAT.m
r572 r1204 1 1 C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 2 ;;1.0;C0C;;May 19, 2009;Build 38 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 23 STOP ; STOP A CURRENTLY RUNNING BATCH JOB 24 25 26 27 28 29 30 31 32 33 34 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 35 START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION 36 37 38 39 40 41 42 43 44 45 46 47 48 49 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 50 EN ; BATCH ENTRY POINT 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 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 148 BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME 149 150 151 152 153 154 155 156 157 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 158 COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS 159 160 161 162 163 164 165 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 166 UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 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 188 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 189 190 191 192 193 194 195 196 197 198 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 199 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 200 201 202 203 204 205 206 207 208 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 209 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 210 211 212 213 214 215 216 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 217 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 218 219 220 221 222 223 224 225 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 226 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 227 228 229 230 231 232 233 234 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/trunk/p/C0CCCD.m
r508 r1204 1 1 C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 ; EXPORT A CCR 22 ; 23 23 EXPORT ; EXPORT ENTRY POINT FOR CCR 24 25 26 27 28 29 30 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 31 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 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 51 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 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 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 148 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 149 150 151 152 153 154 155 156 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 157 SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT 158 159 160 161 162 163 164 165 166 167 168 169 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 170 UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE 171 172 173 174 175 176 177 178 179 180 181 182 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 183 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 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 202 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 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 227 TEST ; RUN ALL THE TEST CASES 228 229 230 228 D TESTALL^C0CUNIT("C0CCCR") 229 Q 230 ; 231 231 ZTEST(WHICH) ; RUN ONE SET OF TESTS 232 233 234 235 236 232 N ZTMP 233 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 234 D ZTEST^C0CUNIT(.ZTMP,WHICH) 235 Q 236 ; 237 237 TLIST ; LIST THE TESTS 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 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/trunk/p/C0CCCD1.m
r508 r1204 1 1 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 W "This is a CCD TEMPLATE with processing routines",! 22 W ! 23 Q 24 ; 25 25 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 26 27 28 29 30 31 32 33 34 35 36 37 38 39 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 40 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 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 60 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 61 62 63 64 61 D ZLOAD(ARY,"C0CCCD1") 62 ; ZWR @ARY 63 Q 64 ; 65 65 TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD 66 66 Q 67 67 MARKUP ;<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 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/trunk/p/C0CCCR.m
r974 r1204 1 1 C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 ; EXPORT A CCR 22 ; 23 23 EXPORT ; EXPORT ENTRY POINT FOR CCR 24 25 26 27 28 29 30 31 XPAT(DFN,XPARMS,DIR,FN) 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 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,XPARMS,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 CCRGLO,UDIR,UFN 35 S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC 36 I '$D(DIR) S UDIR="" 37 E S UDIR=DIR 38 I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED 39 E S UFN=FN 40 I '$D(XPARMS) S XPARMS="" 41 N C0CRTN ; RETURN ARRAY 42 D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR") 43 S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1)) 44 S ONAM=UFN 45 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml" 46 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 47 S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE 48 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR") 49 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 50 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q 51 . ;S @ODIRGLB="/home/glilly/CCROUT" 52 . ;S @ODIRGLB="/home/cedwards/" 53 . S @ODIRGLB="/opt/wv/p/" 54 S ODIR=UDIR 55 I UDIR="" S ODIR=@ODIRGLB 56 N ZY 57 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 58 W !,$P(ZY,U,2),! 59 Q 60 ; 61 61 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED 62 63 64 65 66 67 68 69 62 ; 63 N G1 64 S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) 65 I $D(@G1@(0)) D ; CCR EXISTS 66 . D PARY^C0CXPATH(G1) 67 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",! 68 Q 69 ; 70 70 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT 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 71 ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE 72 ; DFN IS PATIENT IEN 73 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 74 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 75 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 76 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 77 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 78 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 79 K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT 80 M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS 81 K ^TMP($J) ; START CLEAN 82 I '$D(DEBUG) S DEBUG=0 83 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD 84 I '$D(CCRPARMS) S CCRPARMS="" 85 I '$D(CCRPART) S CCRPART="CCR" 86 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)="" 87 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES 88 I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS 89 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION 90 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION 91 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION 92 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 93 S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 94 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 95 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 96 ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL 97 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 98 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 99 ; 100 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 101 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 102 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 103 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 104 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 105 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 106 ; 107 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES 108 ; 109 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 110 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 111 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 112 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 113 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 114 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE 115 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 116 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 117 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 118 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 119 . S IXML="INXML" 120 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 121 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY 122 . ; W OXML,! 123 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 124 . W "RUNNING ",CALL,! 125 . X CALL 126 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 127 . I $G(@OXML@(0))>0 D ; THERE IS A RESULT 128 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 129 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 130 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING 131 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 132 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 133 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 134 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 135 K ACTT,ACTT2 136 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT") 137 D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2") 138 D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments") 139 K CMTT,CMTT2 140 N TRIMI,J,DONE S DONE=0 141 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 142 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS 143 . I DEBUG W "TRIMMED",J,! 144 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 145 ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL 146 I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR 147 E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART 148 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))="" 149 K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP 150 K ^TMP($J) ; REALLY CLEAN UP 151 M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J 152 Q 153 ; 154 154 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 155 156 157 158 159 160 161 162 163 164 165 166 167 168 155 ; TAB IS PASSED BY NAME 156 I DEBUG W "TAB= ",TAB,! 157 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 158 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 159 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")") 160 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 161 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")") 162 I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 163 E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 164 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")") 165 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")") 166 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 167 Q 168 ; 169 169 HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT 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 170 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 171 ; K @VMAP 172 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 173 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 174 D ; ALWAYS MAP THESE VARIABLES 175 . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR 176 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 177 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER 178 . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 179 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 180 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 181 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 182 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 183 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 184 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED 185 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 186 N CTMP 187 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 188 D CP^C0CXPATH("CTMP",CXML) 189 N HRIMVARS ; 190 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS 191 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE 192 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT 193 Q 194 ; 195 195 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 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 196 ; AXML AND ACTRTN ARE PASSED BY NAME 197 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 198 ; P1= OBJECTID - ACTORPATIENT_2 199 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 200 ;OR INSTITUTION 201 ; OR PERSON(IN PATIENT FILE IE NOK) 202 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 203 N I,J,K,L 204 K @ACTRTN ; CLEAR RETURN ARRAY 205 F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS 206 . I @AXML@(I)?.E1"_<".E D ; 207 . . N ZA,ZB 208 . . S ZA=$P(@AXML@(I),">",1)_">" 209 . . S ZB="<"_$P(@AXML@(I),"<",3) 210 . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB 211 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 212 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 213 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 214 . . I $G(LINKDEBUG) W "<ActorID>=>",J,! 215 . . I J'="" S K(J)="" ; HASHING ACTOR 216 . I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE 217 . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1) 218 . . I $G(LINKDEBUG) W "<LinkID>=>",J,! 219 . . I J'="" S K(J)="" ; HASHING ACTOR 220 . . ; TO GET RID OF DUPLICATES 221 S I="" ; GOING TO $O THROUGH THE HASH 222 F J=0:0 D Q:$O(K(I))="" 223 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 224 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 225 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 226 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 227 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 228 Q 229 ; 230 230 TEST ; RUN ALL THE TEST CASES 231 232 233 231 D TESTALL^C0CUNIT("C0CCCR") 232 Q 233 ; 234 234 ZTEST(WHICH) ; RUN ONE SET OF TESTS 235 236 237 238 239 235 N ZTMP 236 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 237 D ZTEST^C0CUNIT(.ZTMP,WHICH) 238 Q 239 ; 240 240 TLIST ; LIST THE TESTS 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 241 N ZTMP 242 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 243 D TLIST^C0CUNIT(.ZTMP) 244 Q 245 ; 246 ;;><TEST> 247 ;;><PROBLEMS> 248 ;;>>>K C0C S C0C="" 249 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","") 250 ;;>>?@C0C@(@C0C@(0))["</Problems>" 251 ;;><VITALS> 252 ;;>>>K C0C S C0C="" 253 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","") 254 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 255 ;;><CCR> 256 ;;>>>K C0C S C0C="" 257 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 258 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 259 ;;><ACTLST> 260 ;;>>>K C0C S C0C="" 261 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 262 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 263 ;;><ACTORS> 264 ;;>>>D ZTEST^C0CCCR("ACTLST") 265 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 266 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 267 ;;>>?G3(G3(0))["</Actors>" 268 ;;><TRIM> 269 ;;>>>D ZTEST^C0CCCR("CCR") 270 ;;>>>W $$TRIM^C0CXPATH(CCRGLO) 271 ;;><ALERTS> 272 ;;>>>S TESTALERT=1 273 ;;>>>K C0C S C0C="" 274 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") 275 ;;>>?@C0C@(@C0C@(0))["</Alerts>" 276 277 -
ccr/trunk/p/C0CCCR0.m
r781 r1204 1 C0CCCR0 2 ;;1.0;C0C;;May 19, 2009;Build 32 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 907 908 909 910 911 912 913 914 915 916 917 1 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 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 ;;<IDs> 795 ;;<Type> 796 ;;<Text>@@IDTYPE@@</Text> 797 ;;</Type> 798 ;;<ID>@@ID@@</ID> 799 ;;<IssuedBy> 800 ;;<Description> 801 ;;<Text>@@IDDESC@@</Text> 802 ;;</Description> 803 ;;</IssuedBy> 804 ;;</IDs> 805 ;;<Specialty> 806 ;;<Text>@@ACTORSPECIALITY@@</Text> 807 ;;</Specialty> 808 ;;<Address> 809 ;;<Type> 810 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 811 ;;</Type> 812 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 813 ;;<City>@@ACTORADDRESSCITY@@</City> 814 ;;<State>@@ACTORADDRESSSTATE@@</State> 815 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode> 816 ;;</Address> 817 ;;<Telephone> 818 ;;<Value>@@ACTORTELEPHONE@@</Value> 819 ;;<Type> 820 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 821 ;;</Type> 822 ;;</Telephone> 823 ;;<Email> 824 ;;<Value>@@ACTOREMAIL@@</Value> 825 ;;</Email> 826 ;;<Source> 827 ;;<Actor> 828 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 829 ;;</Actor> 830 ;;</Source> 831 ;;<InternalCCRLink> 832 ;;<LinkID>@@ACTORORGLINK@@</LinkID> 833 ;;<LinkRelationship>representedOrganization</LinkRelationship> 834 ;;</InternalCCRLink> 835 ;;</Actor> 836 ;;</ACTOR-PROVIDER> 837 ;;<ACTOR-ORG> 838 ;;<Actor> 839 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 840 ;;<Organization> 841 ;;<Name>@@ORGANIZATIONNAME@@</Name> 842 ;;</Organization> 843 ;;<Address> 844 ;;<Type> 845 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 846 ;;</Type> 847 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 848 ;;<City>@@ACTORADDRESSCITY@@</City> 849 ;;<State>@@ACTORADDRESSSTATE@@</State> 850 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode> 851 ;;</Address> 852 ;;<Telephone> 853 ;;<Value>@@ACTORTELEPHONE@@</Value> 854 ;;<Type> 855 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 856 ;;</Type> 857 ;;</Telephone> 858 ;;<Source> 859 ;;<Actor> 860 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 861 ;;</Actor> 862 ;;</Source> 863 ;;</Actor> 864 ;;</ACTOR-ORG> 865 ;;</Actors> 866 ;;<Signatures> 867 ;;<CCRSignature> 868 ;;<SignatureObjectID>S0001</SignatureObjectID> 869 ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime> 870 ;;<Source> 871 ;;<ActorID>AA0001</ActorID> 872 ;;</Source> 873 ;;<Signature> 874 ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#"> 875 ;;<SignedInfo> 876 ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/> 877 ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/> 878 ;;<Reference URI=""> 879 ;;<Transforms> 880 ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/> 881 ;;</Transforms> 882 ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/> 883 ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue> 884 ;;</Reference> 885 ;;</SignedInfo> 886 ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue> 887 ;;<KeyInfo> 888 ;;<KeyValue> 889 ;;<RSAKeyValue> 890 ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus> 891 ;;<Exponent>AQAB</Exponent> 892 ;;</RSAKeyValue> 893 ;;</KeyValue> 894 ;;</KeyInfo> 895 ;;</Signature> 896 ;;</Signature> 897 ;;</CCRSignature> 898 ;;</Signatures> 899 ;;<Comments> 900 ;;<Comment> 901 ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID> 902 ;;<DateTime> 903 ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime> 904 ;;</DateTime> 905 ;;<Description> 906 ;;<Text> 907 ;;</Text> 908 ;;</Description> 909 ;;<Source> 910 ;;<Actor> 911 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 912 ;;</Actor> 913 ;;</Source> 914 ;;</Comment> 915 ;;</Comments> 916 ;;</ContinuityOfCareRecord> 917 ;</TEMPLATE> -
ccr/trunk/p/C0CCMT.m
r785 r1204 1 C0CCMT 2 ;;1.0;C0C;;May 21, 2010; 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.0;C0C;;May 21, 2010;Build 38 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/trunk/p/C0CCPT.m
r780 r1204 1 1 C0CCPT ;;BSL;RETURN CPT DATA; 2 ;Sequence Managers Software GPL 2 ;Sequence Managers Software GPL;;;;;Build 38 3 3 ;Copied into C0C namespace from SQMCPT with permission from 4 4 ;Brian Lord - and with our thanks. gpl 01/20/2010 … … 9 9 ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE 10 10 ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 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 S Z="" 22 F S Z=$O(NOTE(Z)) Q:Z="" D 23 . S DT=$P(^TIU(8925,Z,0),U,7) 24 . I $G(STDT)]"" D 25 .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED 26 . I $G(ENDDT)]"" D 27 .. I ENDDT<DT S NOTE(Z)="D" 28 . I NOTE(Z)="D" K NOTE(Z) 29 29 D VISIT 30 31 VISIT 30 Q 31 VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT 32 32 S ILST=1,X0="",X12="",VISIT="",LST="",X811="" 33 33 S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D -
ccr/trunk/p/C0CDOM.m
r1203 r1204 126 126 Q 127 127 ; 128 OUTXML(ZRTN,INID ) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM128 OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 129 129 ; 130 130 S C0CDOCID=INID 131 D START^C0CMXMLB($$TAG(1),,"G") 131 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation 132 D START^C0CMXMLB($$TAG(1),,"G",NO1ST) 132 133 D NDOUT($$FIRST(1)) 133 134 D END^C0CMXMLB ;END THE DOCUMENT … … 156 157 S GN2=$NA(@GN@(1)) 157 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 W !,ZGOUT," ",ZGIN 165 S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM 166 D OUTXML(ZGOUT,C0CDOCID) 158 167 Q 159 168 ; … … 217 226 I '$D(INARY) Q 0 ; NO ARRAY PASSED 218 227 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM 228 ;I PARENT="" S PARENT="root" 219 229 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID 220 E I $L( PARENT)>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL230 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL 221 231 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE 222 232 . S ZPARNODE=1 ; 223 233 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET 224 D MAJOR(INARY,"",0) ; PROCESS ALL THE NODES TO BE ADDED 225 I $L(PARENT)>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE 226 Q 1 ; SUCCESS 234 N ZEXARY 235 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY 236 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED 237 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE 238 Q HANDLE ; SUCCESS 227 239 ; 228 MAJOR(ZARY ,ZTAG,ZNUM) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES240 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES 229 241 N ZI S ZI="" 242 N ZTAG 230 243 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION 244 . N ZELEADD S ZELEADD=0 245 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES 246 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG 247 . . K ZATT ; CLEAR OUT LAST ONE 248 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY 249 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE 250 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE 251 . I $O(@ZARY@(ZI,""))="" D ;END NODE 252 . . S ZTAG=ZI ; USE ZI FOR THE TAG 253 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE 254 . . S ZELEADD=1 ; ADDED AN ELEMENT 255 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE 256 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL 257 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING 258 . N NEWARY ; INDENTED ARRAY 231 259 . N ZN S ZN=0 232 260 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE 233 . . N ZS S ZS="" 234 . . I $O(@ZARY@(ZI,ZN,ZS))'["." D ; END NODES HERE 235 . . . N NEWARY 236 . . . S NEWARY=$NA(@ZARY@(ZI,ZN)) 237 . . . D MINOR("NEWARY") ; INSERT THE END NODES 238 . . E F S ZS=$O(@ZARY@(ZI,ZN,ZS)) Q:ZS="" D ; FOR EACH STRING 239 . . . I ZS["." D ; INTERMEDIATE NODE FOUND 240 . . . . W !,"IM:",ZS 241 . . . W !,ZI,":",ZN,":",ZS_" : ",@ZARY@(ZI,ZN,ZS) 242 Q 243 ; 244 MINOR(ZINARY) ; DOES THE WORK FOR END NODES, HANDLES ATTRIBUTES 245 ; 246 N ZZI S ZZI="" 247 F S ZZI=$O(@ZINARY@(ZZI)) Q:ZZI="" D ; 248 . W !,"MINOR",ZZI,":",@ZINARY@(ZZI) 261 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG 262 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY 263 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY 264 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG 249 265 Q 250 266 ; … … 268 284 . . . N ZZV ; PLACE TO STASH THE VALUE 269 285 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE 286 . . . W !,"VALUE:",ZZV 270 287 . . . N GK ; COUNTER 271 288 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE … … 292 309 Q 293 310 ; 294 POP(OSTR,ISTR) ; EXTRINSIC WHICH RETURNS TRUE IF ISTR IS EMPTY295 ; IF ISTR IS NOT EMPTY, LOOKS FOR "." AND "@" AND RETURNS296 ; xxx,1,yyyetc for xxx.yyyetc and xx@,1,yyy for xxx@yyyetc297 ; OSTR IS PASSED BY REFERENCE AND CONTAINS yyyetc298 I $L(ISTR)=0 Q 1 ; WE ARE DONE299 N ZG,ZN,ZR300 S ZN=1301 I ISTR["." D ;302 . S ZG=$P(ISTR,".",1)303 . S OSTR=$P(ISTR,".",2)304 . S ZR=ZG_","_ZN_","_OSTR305 Q ZR306 ;307 311 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE 308 312 N CBK,SUCCESS,LEVEL,NODE,HANDLE … … 314 318 Q HANDLE 315 319 ; 316 317 -
ccr/trunk/p/C0CDPT.m
r767 r1204 1 1 C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 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 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ; 4 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 5 ; General Public License. 6 ; 7 ; This program is distributed in the hope that it will be useful, 8 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 9 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 10 ; GNU General Public License for more details. 11 ; 12 ; You should have received a copy of the GNU General Public License along 13 ; with this program; if not, write to the Free Software Foundation, Inc., 14 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 15 ; 16 ; FAMILY Family Name 17 ; GIVEN Given Name 18 ; MIDDLE Middle Name 19 ; SUFFIX Suffix Name 20 ; DISPNAME Display Name 21 ; DOB Date of Birth 22 ; GENDER Get Gender 23 ; SSN Get SSN for ID 24 ; ADDRTYPE Get Home Address 25 ; ADDR1 Get Home Address line 1 26 ; ADDR2 Get Home Address line 2 27 ; CITY Get City for Home Address 28 ; STATE Get State for Home Address 29 ; ZIP Get Zip code for Home Address 30 ; COUNTY Get County for our Address 31 ; COUNTRY Get Country for our Address 32 ; RESTEL Residential Telephone 33 ; WORKTEL Work Telephone 34 ; EMAIL Email Adddress 35 ; CELLTEL Cell Phone 36 ; NOK1FAM Next of Kin 1 (NOK1) Family Name 37 ; NOK1GIV NOK1 Given Name 38 ; NOK1MID NOK1 Middle Name 39 ; NOK1SUF NOK1 Suffi Name 40 ; NOK1DISP NOK1 Display Name 41 ; NOK1REL NOK1 Relationship to the patient 42 ; NOK1ADD1 NOK1 Address 1 43 ; NOK1ADD2 NOK1 Address 2 44 ; NOK1CITY NOK1 City 45 ; NOK1STAT NOK1 State 46 ; NOK1ZIP NOK1 Zip Code 47 ; NOK1HTEL NOK1 Home Telephone 48 ; NOK1WTEL NOK1 Work Telephone 49 ; NOK1SAME Is NOK1's Address the same the patient? 50 ; NOK2FAM NOK2 Family Name 51 ; NOK2GIV NOK2 Given Name 52 ; NOK2MID NOK2 Middle Name 53 ; NOK2SUF NOK2 Suffi Name 54 ; NOK2DISP NOK2 Display Name 55 ; NOK2REL NOK2 Relationship to the patient 56 ; NOK2ADD1 NOK2 Address 1 57 ; NOK2ADD2 NOK2 Address 2 58 ; NOK2CITY NOK2 City 59 ; NOK2STAT NOK2 State 60 ; NOK2ZIP NOK2 Zip Code 61 ; NOK2HTEL NOK2 Home Telephone 62 ; NOK2WTEL NOK2 Work Telephone 63 ; NOK2SAME Is NOK2's Address the same the patient? 64 ; EMERFAM Emergency Contact (EMER) Family Name 65 ; EMERGIV EMER Given Name 66 ; EMERMID EMER Middle Name 67 ; EMERSUF EMER Suffi Name 68 ; EMERDISP EMER Display Name 69 ; EMERREL EMER Relationship to the patient 70 ; EMERADD1 EMER Address 1 71 ; EMERADD2 EMER Address 2 72 ; EMERCITY EMER City 73 ; EMERSTAT EMER State 74 ; EMERZIP EMER Zip Code 75 ; EMERHTEL EMER Home Telephone 76 ; EMERWTEL EMER Work Telephone 77 ; EMERSAME Is EMER's Address the same the NOK? 78 ; 79 W "No Entry at top!" Q 80 ; 81 ;**Revision History** 82 ; - June 15, 08: v0.1 using merged global 83 ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes. 84 ; 85 ; All methods are Public and Extrinsic 86 ; All calls use Fileman file 2 (Patient). 87 ; You can obtain field numbers using the data dictionary 88 ; 89 89 FAMILY(DFN) ; Family Name 90 91 92 90 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) 91 D NAMECOMP^XLFNAME(.NAME) 92 Q NAME("FAMILY") 93 93 GIVEN(DFN) ; Given Name 94 95 96 94 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) 95 D NAMECOMP^XLFNAME(.NAME) 96 Q NAME("GIVEN") 97 97 MIDDLE(DFN) ; Middle Name 98 99 100 98 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) 99 D NAMECOMP^XLFNAME(.NAME) 100 Q NAME("MIDDLE") 101 101 SUFFIX(DFN) ; Suffi Name 102 103 104 102 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) 103 D NAMECOMP^XLFNAME(.NAME) 104 Q NAME("SUFFIX") 105 105 DISPNAME(DFN) ; Display Name 106 107 108 106 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) 107 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 108 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 109 109 DOB(DFN) ; Date of Birth 110 111 112 110 N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I") 111 ; Date in FM Date Format. Convert to UTC/ISO 8601. 112 Q $$FMDTOUTC^C0CUTIL(DOB,"D") 113 113 GENDER(DFN) ; Gender/Sex 114 114 Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ; 115 115 SSN(DFN) ; SSN 116 116 Q $$GET1^DIQ(2,DFN,.09) 117 117 ADDRTYPE(DFN) ; Address Type 118 119 118 ; Vista only stores a home address for the patient. 119 Q "Home" 120 120 ADDR1(DFN) ; Get Home Address line 1 121 121 Q $$GET1^DIQ(2,DFN,.111) 122 122 ADDR2(DFN) ; Get Home Address line 2 123 124 125 126 127 123 ; Vista has Lines 2,3; CCR has only line 1,2; so compromise 124 N ADDLN2,ADDLN3 125 S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113) 126 Q:ADDLN3="" ADDLN2 127 Q ADDLN2_", "_ADDLN3 128 128 CITY(DFN) ; Get City for Home Address 129 129 Q $$GET1^DIQ(2,DFN,.114) 130 130 STATE(DFN) ; Get State for Home Address 131 131 Q $$GET1^DIQ(2,DFN,.115) 132 132 ZIP(DFN) ; Get Zip code for Home Address 133 133 Q $$GET1^DIQ(2,DFN,.116) 134 134 COUNTY(DFN) ; Get County for our Address 135 135 Q $$GET1^DIQ(2,DFN,.117) 136 136 COUNTRY(DFN) ; Get Country for our Address 137 138 137 ; Unfortunately, it's not stored anywhere in Vista, so the inevitable... 138 Q "USA" 139 139 RESTEL(DFN) ; Residential Telephone 140 140 Q $$GET1^DIQ(2,DFN,.131) 141 141 WORKTEL(DFN) ; Work Telephone 142 142 Q $$GET1^DIQ(2,DFN,.132) 143 143 EMAIL(DFN) ; Email Adddress 144 144 Q $$GET1^DIQ(2,DFN,.133) 145 145 CELLTEL(DFN) ; Cell Phone 146 146 Q $$GET1^DIQ(2,DFN,.134) 147 147 NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name 148 149 150 148 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) 149 D NAMECOMP^XLFNAME(.NAME) 150 Q NAME("FAMILY") 151 151 NOK1GIV(DFN) ; NOK1 Given Name 152 153 154 152 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) 153 D NAMECOMP^XLFNAME(.NAME) 154 Q NAME("GIVEN") 155 155 NOK1MID(DFN) ; NOK1 Middle Name 156 157 158 156 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) 157 D NAMECOMP^XLFNAME(.NAME) 158 Q NAME("MIDDLE") 159 159 NOK1SUF(DFN) ; NOK1 Suffi Name 160 161 162 160 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) 161 D NAMECOMP^XLFNAME(.NAME) 162 Q NAME("SUFFIX") 163 163 NOK1DISP(DFN) ; NOK1 Display Name 164 165 166 164 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) 165 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 166 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 167 167 NOK1REL(DFN) ; NOK1 Relationship to the patient 168 168 Q $$GET1^DIQ(2,DFN,.212) 169 169 NOK1ADD1(DFN) ; NOK1 Address 1 170 170 Q $$GET1^DIQ(2,DFN,.213) 171 171 NOK1ADD2(DFN) ; NOK1 Address 2 172 173 174 175 172 N ADDLN2,ADDLN3 173 S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215) 174 Q:ADDLN3="" ADDLN2 175 Q ADDLN2_", "_ADDLN3 176 176 NOK1CITY(DFN) ; NOK1 City 177 177 Q $$GET1^DIQ(2,DFN,.216) 178 178 NOK1STAT(DFN) ; NOK1 State 179 179 Q $$GET1^DIQ(2,DFN,.217) 180 180 NOK1ZIP(DFN) ; NOK1 Zip Code 181 181 Q $$GET1^DIQ(2,DFN,.218) 182 182 NOK1HTEL(DFN) ; NOK1 Home Telephone 183 183 Q $$GET1^DIQ(2,DFN,.219) 184 184 NOK1WTEL(DFN) ; NOK1 Work Telephone 185 185 Q $$GET1^DIQ(2,DFN,.21011) 186 186 NOK1SAME(DFN) ; Is NOK1's Address the same the patient? 187 187 Q $$GET1^DIQ(2,DFN,.2125) 188 188 NOK2FAM(DFN) ; NOK2 Family Name 189 190 191 189 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) 190 D NAMECOMP^XLFNAME(.NAME) 191 Q NAME("FAMILY") 192 192 NOK2GIV(DFN) ; NOK2 Given Name 193 194 195 193 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) 194 D NAMECOMP^XLFNAME(.NAME) 195 Q NAME("GIVEN") 196 196 NOK2MID(DFN) ; NOK2 Middle Name 197 198 199 197 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) 198 D NAMECOMP^XLFNAME(.NAME) 199 Q NAME("MIDDLE") 200 200 NOK2SUF(DFN) ; NOK2 Suffi Name 201 202 203 201 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) 202 D NAMECOMP^XLFNAME(.NAME) 203 Q NAME("SUFFIX") 204 204 NOK2DISP(DFN) ; NOK2 Display Name 205 206 207 205 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) 206 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 207 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 208 208 NOK2REL(DFN) ; NOK2 Relationship to the patient 209 209 Q $$GET1^DIQ(2,DFN,.2192) 210 210 NOK2ADD1(DFN) ; NOK2 Address 1 211 211 Q $$GET1^DIQ(2,DFN,.2193) 212 212 NOK2ADD2(DFN) ; NOK2 Address 2 213 214 215 216 213 N ADDLN2,ADDLN3 214 S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195) 215 Q:ADDLN3="" ADDLN2 216 Q ADDLN2_", "_ADDLN3 217 217 NOK2CITY(DFN) ; NOK2 City 218 218 Q $$GET1^DIQ(2,DFN,.2196) 219 219 NOK2STAT(DFN) ; NOK2 State 220 220 Q $$GET1^DIQ(2,DFN,.2197) 221 221 NOK2ZIP(DFN) ; NOK2 Zip Code 222 222 Q $$GET1^DIQ(2,DFN,.2198) 223 223 NOK2HTEL(DFN) ; NOK2 Home Telephone 224 224 Q $$GET1^DIQ(2,DFN,.2199) 225 225 NOK2WTEL(DFN) ; NOK2 Work Telephone 226 226 Q $$GET1^DIQ(2,DFN,.211011) 227 227 NOK2SAME(DFN) ; Is NOK2's Address the same the patient? 228 228 Q $$GET1^DIQ(2,DFN,.21925) 229 229 EMERFAM(DFN) ; Emergency Contact (EMER) Family Name 230 231 232 230 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) 231 D NAMECOMP^XLFNAME(.NAME) 232 Q NAME("FAMILY") 233 233 EMERGIV(DFN) ; EMER Given Name 234 235 236 234 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) 235 D NAMECOMP^XLFNAME(.NAME) 236 Q NAME("GIVEN") 237 237 EMERMID(DFN) ; EMER Middle Name 238 239 240 238 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) 239 D NAMECOMP^XLFNAME(.NAME) 240 Q NAME("MIDDLE") 241 241 EMERSUF(DFN) ; EMER Suffi Name 242 243 244 242 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) 243 D NAMECOMP^XLFNAME(.NAME) 244 Q NAME("SUFFIX") 245 245 EMERDISP(DFN) ; EMER Display Name 246 247 248 246 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) 247 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 248 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 249 249 EMERREL(DFN) ; EMER Relationship to the patient 250 250 Q $$GET1^DIQ(2,DFN,.331) 251 251 EMERADD1(DFN) ; EMER Address 1 252 252 Q $$GET1^DIQ(2,DFN,.333) 253 253 EMERADD2(DFN) ; EMER Address 2 254 255 256 257 254 N ADDLN2,ADDLN3 255 S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335) 256 Q:ADDLN3="" ADDLN2 257 Q ADDLN2_", "_ADDLN3 258 258 EMERCITY(DFN) ; EMER City 259 259 Q $$GET1^DIQ(2,DFN,.336) 260 260 EMERSTAT(DFN) ; EMER State 261 261 Q $$GET1^DIQ(2,DFN,.337) 262 262 EMERZIP(DFN) ; EMER Zip Code 263 263 Q $$GET1^DIQ(2,DFN,.338) 264 264 EMERHTEL(DFN) ; EMER Home Telephone 265 265 Q $$GET1^DIQ(2,DFN,.339) 266 266 EMERWTEL(DFN) ; EMER Work Telephone 267 267 Q $$GET1^DIQ(2,DFN,.33011) 268 268 EMERSAME(DFN) ; Is EMER's Address the same the NOK? 269 269 Q $$GET1^DIQ(2,DFN,.3305) -
ccr/trunk/p/C0CENC.m
r786 r1204 1 C0CENC 2 ;;1.0;C0C;;May 21, 2010; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXTRACT(ENCXML,DFN,ENCOUT) 25 26 27 28 29 30 31 32 33 34 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) 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 GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 ANYTXT(ZVST) 130 131 132 133 134 135 136 137 138 139 140 141 142 143 PRV(IARY) 144 145 146 147 148 149 150 151 DATE(ISTR) 152 153 154 CPT(ISTR) 155 156 157 158 159 160 161 162 163 164 165 166 167 168 MAP(ENCXML,C0CENC,ENCOUT) 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 1 C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10 2 ;;1.0;C0C;;May 21, 2010;Build 38 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(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO XML TEMPLATE 25 ; ENCXML AND ENCOUT 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(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE 29 K @C0CENC 30 D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS 31 D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS 32 Q 33 ; 34 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 35 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 36 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES 37 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT 38 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 39 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM 40 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS 41 ; 42 ;K VISIT,LST,NOTE 43 I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE 44 I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE 45 ; NEED TO ADD START AND END DATES FROM PARAMETERS 46 N ZI S ZI="" 47 N PREVCPT,PREVDT S (PREVCPT,PREVDT)="" 48 F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST 49 . N ZDATE 50 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0)) 51 . S ZPRVARY=$NA(VISIT(ZI,"PRV")) 52 . N ZPRV 53 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM 54 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 55 . ; ENCOBJECTID - ENCOUNTER OBJECT ID 56 . ; ENCDATETIME - ENCOUNTER DATE TIME 57 . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL) 58 . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE 59 . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4 60 . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT 61 . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE 62 . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM 63 . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID 64 . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID 65 . ; ENCINDTXT - ENCOUNTER INDICATION TEXT 66 . ; ENCINDCODE - ENCOUNTER INDICATION CODE 67 . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM 68 . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID 69 . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION 70 . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI 71 . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME 72 . S ZRNF("ENCTYPETXT")="" 73 . S ZRNF("ENCTYPECODE")="" 74 . S ZRNF("ENCTYPECODESYS")="" 75 . S ZRNF("ENCDESCTXT")="" 76 . S ZRNF("ENCDESCCODE")="" 77 . S ZRNF("ENCDESCCODESYS")="" 78 . N TYPTXT,TYPCDE,TYPSYS ; WILL BE UPDATED BY GETTYPE CALL 79 . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D ; RETURNS FALSE IF NO TYPE 80 . . S ZRNF("ENCTYPETXT")=TYPTXT 81 . . S ZRNF("ENCTYPECODE")=TYPCDE 82 . . S ZRNF("ENCTYPECODESYS")=TYPSYS 83 . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE 84 . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT) 85 . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA 86 . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1" 87 . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER 88 . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE 89 . S ZRNF("ENCINDCODE")="" 90 . S ZRNF("ENCINDCODESYS")="" 91 . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER 92 . S ZRNF("ENCCOMMENTID")="" 93 . I $G(VISIT(ZI,"TEXT",1))'="" D ; THERE IS A NOTE 94 . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE 95 . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI 96 . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE 97 . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE 98 . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER 99 . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY 100 . ;S PREVCPT=ZCPT 101 . ;S PREVDT=ZDATE 102 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS")) 103 M @ZRIM=@C0CENC@("V") 104 K VISIT,LST,NOTE 105 Q 106 ; 107 GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE 108 ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE 109 ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM 110 ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE 111 ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10 112 N ZS,ZC 113 S ZC="" S ZS="" 114 S (ZTXT,ZCDE,ZSYS)="" 115 F S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC="" D ; TRY AND FIND A "99" CPT CODE 116 . N ZT 117 . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE 118 . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE? 119 I ZS'="" D ; CODED ENCOUNTER TYPE FOUND 120 . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE 121 . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER 122 . S ZSYS="" 123 . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE 124 I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES 125 I ZTXT="" Q 0 ; FAILED 126 W !,ZTXT 127 Q 1 ; SUCCESS 128 ; 129 ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE 130 ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED) 131 ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME 132 ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY 133 N ZK,ZL 134 S ZK="" S ZL="" 135 F S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK="" D ; LOOK FOR SOME TEXT TO USE 136 . N ZT 137 . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE 138 . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3) 139 . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE 140 I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE 141 Q ZL 142 ; 143 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME 144 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN="" 145 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG 146 . I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER 147 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1) 148 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR 149 Q ZRTN 150 ; 151 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT 152 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT") 153 ; 154 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS 155 ; CPT^CATEGORY^TEXT 156 N Z1,Z2,Z3,ZRTN 157 S Z1=$P(ISTR,U,1) 158 I Z1="" D ; 159 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1) 160 I Z1'="" D ; IF THERE IS A CPT CODE IN THERE 161 . ;S Z1=$P(ISTR,U,1) 162 . S Z2=$P(ISTR,U,2) 163 . S Z3=$P(ISTR,U,3) 164 . S ZRTN=Z1_U_Z2_U_Z3 165 E S ZRTN="" 166 Q ZRTN 167 ; 168 MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML 169 ; 170 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE 171 K @ZTEMP 172 N ZBLD 173 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA 174 D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE 175 N ZINNER 176 D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER 177 N ZTMP,ZVAR,ZI 178 S ZI="" 179 F S ZI=$O(@C0CENC@("V",ZI)) Q:ZI="" D ;FOR EACH ENCOUNTER 180 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML 181 . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES 182 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE 183 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD 184 D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0)) 185 N ZZTMP 186 D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML 187 K @ZTEMP,@ZBLD,@C0CENC 188 Q 189 ; -
ccr/trunk/p/C0CEWD.m
r1060 r1204 1 C0CEWD 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 TOKEN() 23 24 25 STORE(ZARY) 26 27 28 29 30 31 32 33 GET(C0ERTN,C0ETOKEN,NOKILL) 34 35 36 37 38 39 40 41 42 URLTOKEN(sessid) 43 44 45 46 47 48 49 50 cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options) 51 52 53 54 55 56 57 58 59 60 61 62 63 64 set1 65 66 67 68 test1(sessid) 69 70 71 1 C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11 2 ;;0.1;CCDCCR;nopatch;noreleasedate;Build 77 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 TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN 23 Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE 24 ; 25 STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN 26 ; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION 27 ; RETURNS THE TOKEN. ZARY IS PASSED BY NAME 28 N ZT 29 S ZT=$$TOKEN ; GET A NEW TOKEN 30 M ^TMP("C0E","TOKEN",ZT)=@ZARY ; 31 Q ZT 32 ; 33 GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN 34 ; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1 35 ; C0ERTN IS PASSED BY NAME 36 I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D Q ; DOESN'T EXIST 37 . S @C0ERTN="" ; PASS BACK NULL 38 M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE 39 I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE 40 Q 41 ; 42 URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL </