Changeset 685 for ccr/trunk/p
- Timestamp:
- Jan 27, 2010, 12:13:43 PM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CMED3.m
r508 r685 49 49 K NVA 50 50 ; 51 I DEBUG ZWR MEDS51 I DEBUG ZWRITE MEDS 52 52 N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array. 53 53 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE … … 94 94 . . ; I get the RxNorm name and version from the RxNorm Sources (file 95 95 . . ; 176.003), by searching for "RXNORM", then get the data. 96 . . D NDF^PSS50(MEDIEN,,,,,"NDF") 97 . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN) 98 . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 99 . . N VAPROD S VAPROD=$P(NDFDATA(22),U) 96 . . ; NDF^PSS50 ONLY EXISTS ON VISTA 97 . . N NDFDATA,NDFIEN,VAPROD 98 . . S NDFIEN="" 99 . . I '$$RPMS^C0CUTIL() D 100 . . . D NDF^PSS50(MEDIEN,,,,,"NDF") 101 . . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN) 102 . . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 103 . . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U) 104 . . . M NDFDATA=^TMP($J,"NDF",MEDIEN) 105 . . . S NDFIEN=$P(NDFDATA(20),U) 106 . . . S VAPROD=$P(NDFDATA(22),U) 100 107 . . ; 101 108 . . ; NDFIEN is not necessarily defined; it won't be if the drug … … 119 126 . . ; 120 127 . . S @MAP@("MEDBRANDNAMETEXT")="" 121 . . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 122 . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 123 . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 124 . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 128 . . ; DOSE^PSS50 ONLY ESISTS ON VISTA 129 . . I '$$RPMS^C0CUTIL() D 130 . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 131 . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 132 . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 133 . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 134 . . E S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")="" 125 135 . . ; Units, concentration, etc, come from another call 126 136 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit … … 142 152 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 143 153 . . ; Node 14.5 is the Dispense Unit 144 . . D DATA^PSS50(MEDIEN,,,,,"QTY") 145 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 146 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 154 . . ; PSS50 ONLY EXISTS ON VISTA 155 . . I '$$RPMS^C0CUTIL() D 156 . . . D DATA^PSS50(MEDIEN,,,,,"QTY") 157 . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 158 . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 159 . . E S @MAP@("MEDQUANTITYUNIT")="" 147 160 . E D 148 161 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")="" … … 193 206 . ; --- END OF DIRECTIONS --- 194 207 . ; 195 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 196 . I $D(MED(10,1)) D ; 197 . . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field 198 . E S @MAP@("MEDPTINSTRUCTIONS")="" 208 . S @MAP@("MEDRFNO")="" 199 209 . I $D(MED(14,1)) D ; 200 210 . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field 201 211 . E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" 202 . S @MAP@("MEDRFNO")=""203 212 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 204 213 . K @RESULT … … 210 219 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 211 220 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 212 . ;N MDZ1,MDZNA221 . N MDZ1,MDZNA 213 222 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 214 223 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION … … 216 225 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 217 226 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 218 . I MEDFIRST D ; 219 . . S MEDFIRST=0 ; RESET FIRST FLAG 220 . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 221 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML 227 . ; 228 . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION 229 . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE 230 . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT 231 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1) 232 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions") 233 . N MDI1 234 . S MDI1=$NA(@MAP@("I")) 235 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 236 . I $D(MED(10,1)) D ; 237 . . S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field 238 . E S @MAP@("I","MEDPTINSTRUCTIONS")="" 239 . D MAP^C0CXPATH(INTXML1,MDI1,INTXML2) 240 . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication") 241 . ; 242 . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT. 243 . ;I MEDFIRST D ; 244 . ;. S MEDFIRST=0 ; RESET FIRST FLAG 245 . ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 246 . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML 247 . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 248 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 249 . I MEDFIRST S MEDFIRST=0 222 250 N MEDTMP,MEDI 223 251 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
Note:
See TracChangeset
for help on using the changeset viewer.