Changeset 422
- Timestamp:
- Mar 29, 2009, 5:48:58 PM (15 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CMED.m
r421 r422 1 1 C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 2 ;;0. 5;CCDCCR;;JUL 16,2008;2 ;;0.6;CCDCCR;;JUL 16,2008; 3 3 ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. 4 4 ; Licensed under the terms of the GNU General Public License. … … 40 40 ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time. 41 41 ; 42 ; -- Prep variables42 ; --Find out what system we are on... 43 43 I $$RPMS^C0CUTIL() D RPMS QUIT 44 44 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT 45 ; Extraction Sections 45 ; --Get parameters for meds 46 N C0CMFLAG 47 S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") 46 48 RPMS 47 D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML ) QUIT49 D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT 48 50 VISTA 49 51 N MEDCOUNT S MEDCOUNT=0 -
ccr/trunk/p/C0CMED6.m
r416 r422 1 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09 2 ;;0.1;CCDCCR;;JUL 16,2008; 3 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ; General Public License See attached copy of the License. 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License along 17 ; with this program; if not, write to the Free Software Foundation, Inc., 18 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "NO ENTRY FROM TOP",! 21 Q 22 ; 23 EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; MINXML and OUTXML are passed by name so globals can be used 26 ; MINXML will contain only the medications skeleton of the overall template 27 ; 28 ; MEDS is return array from RPC. 29 ; MAP is a mapping variable map (store result) for each med 30 ; MED is holds each array element from MEDS(J), one medicine 31 ; J is a counter. 32 ; 33 ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used. 34 ; This API has been developed by Medsphere for IHS for getting 35 ; Medications from RPMS. It has most of what we need. 36 ; API written by Doug Martin when he worked for Medsphere (thanks Doug!) 37 ; -- ARRAYNAME is passed by name (required) 38 ; -- DFN is passed by value (required) 39 ; -- DAYS is passed by value (optional; if not passed defaults to 365) 40 ; 41 ; Return: 42 ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 43 ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 44 ; Status Reason^DEA Handling 45 ; 46 N MEDS,MEDS1,MAP 47 D GETRXS^BEHORXFN("MEDS1",DFN,365) ; Days hard set to 365 48 ; If MEDS1 is not defined, then no meds 49 I '$D(MEDS1) S @OUTXML@(0)=0 QUIT 50 I DEBUG ZWR MEDS1,MINXML 51 N MEDCNT S MEDCNT=0 ; Med Count 52 ; The next line is a super line. It goes through the array return 53 ; and if the first characters are ~OP, it grabs the line. 54 ; This means that line is for a dispensed Outpatient Med. 55 ; That line has the metadata about the med that I need. 56 ; The next lines, however many, are the med and the sig. 57 ; I won't be using those because I have to get the sig parsed exactly. 58 N J S J="" F S J=$O(MEDS1(J)) Q:J="" I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J) 59 K MEDS1 60 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; this is the variable map 61 S @MEDMAP@(0)=0 ; Initial count of meds 62 S MEDCNT="" ; Initialize for $Order 63 F S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT="" D ; for each medication in the list 64 . I DEBUG W "MEDCNT IS ",MEDCNT,! 65 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT)) 66 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED 67 . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; increment total meds in var array 68 . I DEBUG W "MAP= ",MAP,! 69 . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID 70 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 71 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13)) 72 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 73 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11)) 74 . S @MAP@("MEDRXNOTXT")="Prescription Number" 75 . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14) 76 . S @MAP@("MEDTYPETEXT")="Medication" 77 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 78 . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10) 79 . ; Provider only provided in API as text, not DUZ. 80 . ; We need to get DUZ from filman file 52 (Prescription) 81 . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters. 82 . ; Note that I will use RXIEN several times later 83 . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2) 84 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I") 85 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3) 86 . ; --- RxNorm Stuff 87 . ; 176.001 is the file for Concepts; 176.003 is the file for 88 . ; sources (i.e. for RxNorm Version) 89 . ; 90 . ; I use 176.001 for the Vista version of this routine (files 1-3) 91 . ; Since IHS does not have VUID's, I will be getting RxNorm codes 92 . ; using NDCs. My specially crafted index (sounds evil) named "NDC" 93 . ; is in file 176.002. The file is called RxNorm NDC to VUID. 94 . ; Except that I don't need the VUID, but it's there if I need it. 95 . ; 96 . ; We obviously need the NDC. That is easily obtained from the prescription. 97 . ; Field 27 in file 52 98 . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I") 99 . ; I discovered that file 176.002 might give you two codes for the NDC 100 . ; One for the Clinical Drug, and one for the ingredient. 101 . ; So the plan is to get the two RxNorm codes, and then find from 102 . ; file 176.001 which one is the Clinical Drug. 103 . ; ... I refactored this into GETRXN 104 . N RXNORM,SRCIEN,RXNNAME,RXNVER 105 . I +NDC,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 106 . . S RXNORM=$$GETRXN(NDC) 107 . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B") 108 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 109 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 110 . ; 111 . E S (RXNORM,RXNNAME,RXNVER)="" 112 . ; End if/else block 113 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 114 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 115 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 116 . ; --- End RxNorm section 117 . ; 118 . ; Brand name is 52 field 6.5 119 . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5) 120 . ; 121 . ; Next I need Med Form (tab, cap etc), strength (250mg) 122 . ; concentration for liquids (250mg/mL) 123 . ; Since IHS does not have any of the new calls that 124 . ; Vista has, I will be doing a crosswalk: 125 . ; File 52, field 6 is Drug IEN in file 50 126 . ; File 50, field 22 is VA Product IEN in file 50.68 127 . ; In file 50.68, I will get the following: 128 . ; -- 1: Dosage Form 129 . ; -- 2: Strength 130 . ; -- 3: Units 131 . ; -- 8: Dispense Units 132 . ; -- Conc is 2 concatenated with 3 133 . ; 134 . ; *** If Drug is not matched to NDF, then VA Product will be "" *** 135 . ; 136 . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50 137 . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68 138 . I +VAPROD D 139 . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2) 140 . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3) 141 . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1) 142 . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE") 143 . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT") 144 . E D 145 . . S @MAP@("MEDSTRENGTHVALUE")="" 146 . . S @MAP@("MEDSTRENGTHUNIT")="" 147 . . S @MAP@("MEDFORMTEXT")="" 148 . . S @MAP@("MEDCONCVALUE")="" 149 . . S @MAP@("MEDCONCUNIT")="" 150 . ; End Strengh/Conc stuff 151 . ; 152 . ; Quantity is in the prescription, field 7 153 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7) 154 . ; Dispense unit is in the drug file, field 14.5 155 . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5) 156 . ; 157 . ; --- START OF DIRECTIONS --- 158 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 159 . ; we want the components. 160 . ; It's in multiple 113 in the Prescription File (52) 161 . ; #.01 DOSAGE ORDERED [1F] "20" 162 . ; #1 DISPENSE UNITS PER DOSE [2N] "1" 163 . ; #2 UNITS [3P:50.607] "MG" 164 . ; #3 NOUN [4F] "TABLET" 165 . ; #4 DURATION [5F] "10D" 166 . ; #5 CONJUNCTION [6S] "AND" 167 . ; #6 ROUTE [7P:51.2] "ORAL" 168 . ; #7 SCHEDULE [8F] "BID" 169 . ; #8 VERB [9F] "TAKE" 170 . ; 171 . ; Will use GETS^DIQ to get fields. 172 . ; Data comes out like this: 173 . ; SAMINS(52.0113,"1,23,",.01)=20 174 . ; SAMINS(52.0113,"1,23,",1)=1 175 . ; SAMINS(52.0113,"1,23,",2)="MG" 176 . ; SAMINS(52.0113,"1,23,",3)="TABLET" 177 . ; SAMINS(52.0113,"1,23,",4)="5D" 178 . ; SAMINS(52.0113,"1,23,",5)="THEN" 179 . ; 180 . N RAWDATA 181 . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR") 182 . D:$D(DIERR) ^%ZTER ; Log if there's an error in retrieving sig field 183 . ; none the less, continue; some parts are retrievable. 184 . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile... 185 . K RAWDATA 186 . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman. 187 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 188 . ; DIRCNT is the proper Sigline numer. 189 . ; SIGDATA is the simplfied array. 190 . F S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM="" D 191 . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",") 192 . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM) 193 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 194 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 195 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8)) 196 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01)) 197 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2)) 198 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 199 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 200 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 201 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6)) 202 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7)) 203 . . ; Invervals... again another call. 204 . . ; In the wisdom of the original programmers, the schedule is a free text field 205 . . ; However, it gets translated by a call to the administration schedule file 206 . . ; to see if that schedule exists. 207 . . ; That's the same thing I am going to do. 208 . . ; Search B index of 51.1 (Admin Schedule) with schedule 209 . . ; First, remove "PRN" if it exists (don't ask, that's how the file 210 . . ; works; I wouldn't do it that way). 211 . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7)) 212 . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5) 213 . . ; Super call below: 214 . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes) 215 . . ; 4=Packed format, Exact Match 5=Lookup Value 216 . . ; 6=# of entries to return 7=Index 10=Return Array 217 . . ; 218 . . ; I do not account for the fact that two schedules can be 219 . . ; spelled identically (ie duplicate entry). In that case, 220 . . ; I get the first. That's just a bad pharmacy pkg maintainer. 221 . . N C0C515 222 . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515") 223 . . N INTERVAL S INTERVAL="" ; Default 224 . . ; If there are entries found, get it 225 . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 226 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 227 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 228 . . ; Duration is 10M minutes, 10H hours, 10D for Days 229 . . ; 10W for weeks, 10L for months. I smell $Select 230 . . ; But we don't need to do that if there isn't a duration 231 . . I +$G(SIGDATA(4)) D 232 . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char 233 . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days") 234 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4) 235 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT 236 . . E D 237 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")="" 238 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")="" 239 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN" 240 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail 241 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 242 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 243 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 244 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 245 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 246 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 247 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored 248 . . ; Another confusing line; I am pretty bad: 249 . . ; If there is another entry in the FMSIG array (i.e. another line 250 . . ; in the sig), set the direction count indicator. 251 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")="" ; Default 252 . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT 253 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5)) 254 . ; 255 . ; --- END OF DIRECTIONS --- 256 . ; 257 . ; Med instructions is a WP field, thus the acrobatics 258 . ; Notice buffer overflow protection set at 10,000 chars 259 . ; -- 1. Med Patient Instructions 260 . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1") 261 . N MEDPTIN2,J S (MEDPTIN2,J)="" 262 . I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" " 263 . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2 264 . K J 265 . ; -- 2. Med Provider Instructions 266 . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1") 267 . N MEDPVIN2,J S (MEDPVIN2,J)="" 268 . I $L(MEDPVIN1) F S J=$O(@MEDPVIN1@(J)) Q:J="" Q:$L(MEDPVIN2)>10000 S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" " 269 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2 270 . ; 271 . ; Remaining refills 272 . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6) 273 . ; ------ END OF MAPPING 274 . ; 275 . ; ------ BEGIN XML INSERTION 276 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 277 . K @RESULT 278 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 279 . ; D PARY^C0CXPATH(RESULT) 280 . ; MAPPING DIRECTIONS 281 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 282 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 283 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 284 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 285 . ; N MDZ1,MDZNA 286 . N DIRCNT S DIRCNT="" 287 . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; IF THERE ARE DIRCTIONS 288 . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; FOR EACH DIRECTION 289 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT)) 290 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 291 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 292 . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 293 . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 294 N MEDTMP,MEDI 295 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 296 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 297 . W "MEDICATION MISSING ",! 298 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 299 Q 300 ; 301 GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm 302 ;; Get RxNorm Concept Number for a Given NDC 303 ; 304 S NDC=$TR(NDC,"-") ; Remove dashes 305 N RXNORM,C0CZRXN,DIERR 306 D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR") 307 I $D(DIERR) D ^%ZTER BREAK 308 S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries 309 N I S I=0 310 F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2) 311 ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries 312 ; If RxNorm(0) is 1, then we only have one entry, and that's it. 313 I RXNORM(0)=1 QUIT RXNORM(1) ; RETURN RXNORM(1) 314 ; Otherwise, we need to find out which one is the semantic 315 ; clinical drug. I built an index on 176.001 (RxNorm Concepts) 316 ; for that purpose. 317 I RXNORM(0)>1 D 318 . S I=0 319 . F S I=$O(RXNORM(I)) Q:I="" D Q:$G(RXNORM) 320 . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD") 321 . . I +$G(RXNIEN)=0 QUIT ; try the next entry... 322 . . E S RXNORM=RXNORM(I) QUIT ; We found the right code 323 QUIT +$G(RXNORM) ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0 324 1 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09 2 ;;0.1;CCDCCR;;JUL 16,2008; 3 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ; General Public License See attached copy of the License. 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License along 17 ; with this program; if not, write to the Free Software Foundation, Inc., 18 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "NO ENTRY FROM TOP",! 21 Q 22 ; 23 EXTRACT(MINXML,DFN,OUTXML,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; MINXML and OUTXML are passed by name so globals can be used 26 ; MINXML will contain only the medications skeleton of the overall template 27 ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool) 28 ; FLAGS are set-up in C0CMED. 29 ; 30 ; MEDS is return array from RPC. 31 ; MAP is a mapping variable map (store result) for each med 32 ; MED is holds each array element from MEDS(J), one medicine 33 ; J is a counter. 34 ; 35 ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used. 36 ; This API has been developed by Medsphere for IHS for getting 37 ; Medications from RPMS. It has most of what we need. 38 ; API written by Doug Martin when he worked for Medsphere (thanks Doug!) 39 ; -- ARRAYNAME is passed by name (required) 40 ; -- DFN is passed by value (required) 41 ; -- DAYS is passed by value (optional; if not passed defaults to 365) 42 ; 43 ; Return: 44 ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 45 ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 46 ; Status Reason^DEA Handling 47 ; 48 N MEDS,MEDS1,MAP 49 D GETRXS^BEHORXFN("MEDS1",DFN,$P(FLAGS,U,2)) ; 2nd piece of FLAGS is # of days to retrieve 50 N ALL S ALL=+FLAGS 51 N ACTIVE S ACTIVE=$P(FLAGS,U,3) 52 N PENDING S PENDING=$P(FLAGS,U,4) 53 ; If MEDS1 is not defined, then no meds 54 I '$D(MEDS1) S @OUTXML@(0)=0 QUIT 55 I DEBUG ZWR MEDS1,MINXML 56 N MEDCNT S MEDCNT=0 ; Med Count 57 ; The next line is a super line. It goes through the array return 58 ; and if the first characters are ~OP, it grabs the line. 59 ; This means that line is for a dispensed Outpatient Med. 60 ; That line has the metadata about the med that I need. 61 ; The next lines, however many, are the med and the sig. 62 ; I won't be using those because I have to get the sig parsed exactly. 63 N J S J="" F S J=$O(MEDS1(J)) Q:J="" I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J) 64 K MEDS1 65 S MEDCNT="" ; Initialize for $Order 66 F S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT="" D ; for each medication in the list 67 . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT 68 . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT 69 . I DEBUG W "MEDCNT IS ",MEDCNT,! 70 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT)) 71 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED 72 . I DEBUG W "MAP= ",MAP,! 73 . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID 74 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 75 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13)) 76 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 77 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11)) 78 . S @MAP@("MEDRXNOTXT")="Prescription Number" 79 . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14) 80 . S @MAP@("MEDTYPETEXT")="Medication" 81 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 82 . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10) 83 . ; Provider only provided in API as text, not DUZ. 84 . ; We need to get DUZ from filman file 52 (Prescription) 85 . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters. 86 . ; Note that I will use RXIEN several times later 87 . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2) 88 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I") 89 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3) 90 . ; --- RxNorm Stuff 91 . ; 176.001 is the file for Concepts; 176.003 is the file for 92 . ; sources (i.e. for RxNorm Version) 93 . ; 94 . ; I use 176.001 for the Vista version of this routine (files 1-3) 95 . ; Since IHS does not have VUID's, I will be getting RxNorm codes 96 . ; using NDCs. My specially crafted index (sounds evil) named "NDC" 97 . ; is in file 176.002. The file is called RxNorm NDC to VUID. 98 . ; Except that I don't need the VUID, but it's there if I need it. 99 . ; 100 . ; We obviously need the NDC. That is easily obtained from the prescription. 101 . ; Field 27 in file 52 102 . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I") 103 . ; I discovered that file 176.002 might give you two codes for the NDC 104 . ; One for the Clinical Drug, and one for the ingredient. 105 . ; So the plan is to get the two RxNorm codes, and then find from 106 . ; file 176.001 which one is the Clinical Drug. 107 . ; ... I refactored this into GETRXN 108 . N RXNORM,SRCIEN,RXNNAME,RXNVER 109 . I +NDC,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 110 . . S RXNORM=$$GETRXN(NDC) 111 . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B") 112 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 113 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 114 . ; 115 . E S (RXNORM,RXNNAME,RXNVER)="" 116 . ; End if/else block 117 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 118 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 119 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 120 . ; --- End RxNorm section 121 . ; 122 . ; Brand name is 52 field 6.5 123 . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5) 124 . ; 125 . ; Next I need Med Form (tab, cap etc), strength (250mg) 126 . ; concentration for liquids (250mg/mL) 127 . ; Since IHS does not have any of the new calls that 128 . ; Vista has, I will be doing a crosswalk: 129 . ; File 52, field 6 is Drug IEN in file 50 130 . ; File 50, field 22 is VA Product IEN in file 50.68 131 . ; In file 50.68, I will get the following: 132 . ; -- 1: Dosage Form 133 . ; -- 2: Strength 134 . ; -- 3: Units 135 . ; -- 8: Dispense Units 136 . ; -- Conc is 2 concatenated with 3 137 . ; 138 . ; *** If Drug is not matched to NDF, then VA Product will be "" *** 139 . ; 140 . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50 141 . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68 142 . I +VAPROD D 143 . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2) 144 . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3) 145 . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1) 146 . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE") 147 . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT") 148 . E D 149 . . S @MAP@("MEDSTRENGTHVALUE")="" 150 . . S @MAP@("MEDSTRENGTHUNIT")="" 151 . . S @MAP@("MEDFORMTEXT")="" 152 . . S @MAP@("MEDCONCVALUE")="" 153 . . S @MAP@("MEDCONCUNIT")="" 154 . ; End Strengh/Conc stuff 155 . ; 156 . ; Quantity is in the prescription, field 7 157 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7) 158 . ; Dispense unit is in the drug file, field 14.5 159 . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5) 160 . ; 161 . ; --- START OF DIRECTIONS --- 162 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 163 . ; we want the components. 164 . ; It's in multiple 113 in the Prescription File (52) 165 . ; #.01 DOSAGE ORDERED [1F] "20" 166 . ; #1 DISPENSE UNITS PER DOSE [2N] "1" 167 . ; #2 UNITS [3P:50.607] "MG" 168 . ; #3 NOUN [4F] "TABLET" 169 . ; #4 DURATION [5F] "10D" 170 . ; #5 CONJUNCTION [6S] "AND" 171 . ; #6 ROUTE [7P:51.2] "ORAL" 172 . ; #7 SCHEDULE [8F] "BID" 173 . ; #8 VERB [9F] "TAKE" 174 . ; 175 . ; Will use GETS^DIQ to get fields. 176 . ; Data comes out like this: 177 . ; SAMINS(52.0113,"1,23,",.01)=20 178 . ; SAMINS(52.0113,"1,23,",1)=1 179 . ; SAMINS(52.0113,"1,23,",2)="MG" 180 . ; SAMINS(52.0113,"1,23,",3)="TABLET" 181 . ; SAMINS(52.0113,"1,23,",4)="5D" 182 . ; SAMINS(52.0113,"1,23,",5)="THEN" 183 . ; 184 . N RAWDATA 185 . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR") 186 . D:$D(DIERR) ^%ZTER ; Log if there's an error in retrieving sig field 187 . ; none the less, continue; some parts are retrievable. 188 . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile... 189 . K RAWDATA 190 . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman. 191 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 192 . ; DIRCNT is the proper Sigline numer. 193 . ; SIGDATA is the simplfied array. 194 . F S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM="" D 195 . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",") 196 . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM) 197 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 198 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 199 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8)) 200 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01)) 201 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2)) 202 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 203 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 204 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 205 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6)) 206 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7)) 207 . . ; Invervals... again another call. 208 . . ; In the wisdom of the original programmers, the schedule is a free text field 209 . . ; However, it gets translated by a call to the administration schedule file 210 . . ; to see if that schedule exists. 211 . . ; That's the same thing I am going to do. 212 . . ; Search B index of 51.1 (Admin Schedule) with schedule 213 . . ; First, remove "PRN" if it exists (don't ask, that's how the file 214 . . ; works; I wouldn't do it that way). 215 . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7)) 216 . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5) 217 . . ; Super call below: 218 . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes) 219 . . ; 4=Packed format, Exact Match 5=Lookup Value 220 . . ; 6=# of entries to return 7=Index 10=Return Array 221 . . ; 222 . . ; I do not account for the fact that two schedules can be 223 . . ; spelled identically (ie duplicate entry). In that case, 224 . . ; I get the first. That's just a bad pharmacy pkg maintainer. 225 . . N C0C515 226 . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515") 227 . . N INTERVAL S INTERVAL="" ; Default 228 . . ; If there are entries found, get it 229 . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 230 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 231 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 232 . . ; Duration is 10M minutes, 10H hours, 10D for Days 233 . . ; 10W for weeks, 10L for months. I smell $Select 234 . . ; But we don't need to do that if there isn't a duration 235 . . I +$G(SIGDATA(4)) D 236 . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char 237 . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days") 238 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4) 239 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT 240 . . E D 241 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")="" 242 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")="" 243 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN" 244 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail 245 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 246 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 247 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 248 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 249 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 250 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 251 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored 252 . . ; Another confusing line; I am pretty bad: 253 . . ; If there is another entry in the FMSIG array (i.e. another line 254 . . ; in the sig), set the direction count indicator. 255 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")="" ; Default 256 . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT 257 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5)) 258 . ; 259 . ; --- END OF DIRECTIONS --- 260 . ; 261 . ; Med instructions is a WP field, thus the acrobatics 262 . ; Notice buffer overflow protection set at 10,000 chars 263 . ; -- 1. Med Patient Instructions 264 . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1") 265 . N MEDPTIN2,J S (MEDPTIN2,J)="" 266 . I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" " 267 . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2 268 . K J 269 . ; -- 2. Med Provider Instructions 270 . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1") 271 . N MEDPVIN2,J S (MEDPVIN2,J)="" 272 . I $L(MEDPVIN1) F S J=$O(@MEDPVIN1@(J)) Q:J="" Q:$L(MEDPVIN2)>10000 S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" " 273 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2 274 . ; 275 . ; Remaining refills 276 . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6) 277 . ; ------ END OF MAPPING 278 . ; 279 . ; ------ BEGIN XML INSERTION 280 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 281 . K @RESULT 282 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 283 . ; D PARY^C0CXPATH(RESULT) 284 . ; MAPPING DIRECTIONS 285 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 286 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 287 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 288 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 289 . ; N MDZ1,MDZNA 290 . N DIRCNT S DIRCNT="" 291 . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; IF THERE ARE DIRCTIONS 292 . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; FOR EACH DIRECTION 293 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT)) 294 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 295 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 296 . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 297 . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 298 N MEDTMP,MEDI 299 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 300 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 301 . W "MEDICATION MISSING ",! 302 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 303 Q 304 ; 305 GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm 306 ;; Get RxNorm Concept Number for a Given NDC 307 ; 308 S NDC=$TR(NDC,"-") ; Remove dashes 309 N RXNORM,C0CZRXN,DIERR 310 D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR") 311 I $D(DIERR) D ^%ZTER BREAK 312 S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries 313 N I S I=0 314 F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2) 315 ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries 316 ; If RxNorm(0) is 1, then we only have one entry, and that's it. 317 I RXNORM(0)=1 QUIT RXNORM(1) ; RETURN RXNORM(1) 318 ; Otherwise, we need to find out which one is the semantic 319 ; clinical drug. I built an index on 176.001 (RxNorm Concepts) 320 ; for that purpose. 321 I RXNORM(0)>1 D 322 . S I=0 323 . F S I=$O(RXNORM(I)) Q:I="" D Q:$G(RXNORM) 324 . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD") 325 . . I +$G(RXNIEN)=0 QUIT ; try the next entry... 326 . . E S RXNORM=RXNORM(I) QUIT ; We found the right code 327 QUIT +$G(RXNORM) ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0 328 -
ccr/trunk/p/C0CPARMS.m
r395 r422 1 GPLPARMS; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/092 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 SET(INPARMS) 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 CHECK 52 53 54 55 56 57 GET(WHICHP) 58 59 60 61 62 1 C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 2 ;;0.3;CCDCCR;nopatch;noreleasedate 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS 21 ; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC" 22 ; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS 23 ; 24 N PTMP ; 25 S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN 26 ;K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL 27 I $G(INPARMS)'="" D ; OVERRIDES PROVIDED 28 . N C0CI S C0CI="" 29 . N C0CN S C0CN=1 30 . F S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI="" D ; 31 . . S C0CN=C0CN+1 ;NEXT PARM 32 . . N C1,C2 33 . . S C1=$P(C0CI,":",1) ; PARAMETER 34 . . S C2=$P(C0CI,":",2) ; VALUE 35 . . I C2="" S C2=1 36 . . S @C0CPARMS@(C1)=C2 37 . I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE 38 ; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS 39 ; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS 40 I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH 41 I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY 42 I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS 43 I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY 44 I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY 45 I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS 46 I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES 47 I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO 48 I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE 49 Q 50 ; 51 CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET 52 ; 53 I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN 54 I '$D(@C0CPARMS) D SET("SETWITHCHECK:1") 55 Q 56 ; 57 GET(WHICHP) ;EXTRINSIC TO RETURN THE VALUE OF PARAMETER WHICHP 58 ; 59 D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE 60 N GTMP 61 Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE 62 ;
Note:
See TracChangeset
for help on using the changeset viewer.
