Changeset 685 for ccr


Ignore:
Timestamp:
Jan 27, 2010, 12:13:43 PM (15 years ago)
Author:
Christopher Edwards
Message:

added support for RPMS for Non-VA meds (Home meds)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/C0CMED3.m

    r508 r685  
    4949 K NVA
    5050 ;
    51  I DEBUG ZWR MEDS
     51 I DEBUG ZWRITE MEDS
    5252 N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
    5353 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
     
    9494 . . ; I get the RxNorm name and version from the RxNorm Sources (file
    9595 . . ; 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)
    100107 . . ;
    101108 . . ; NDFIEN is not necessarily defined; it won't be if the drug
     
    119126 . . ;
    120127 . . 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")=""
    125135 . . ; Units, concentration, etc, come from another call
    126136 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
     
    142152 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
    143153 . . ; 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")=""
    147160 . E  D
    148161 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
     
    193206 . ; --- END OF DIRECTIONS ---
    194207 . ;
    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")=""
    199209 . I $D(MED(14,1)) D  ;
    200210 . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
    201211 . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
    202  . S @MAP@("MEDRFNO")=""
    203212 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
    204213 . K @RESULT
     
    210219 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
    211220 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
    212  . ; N MDZ1,MDZNA
     221 . N MDZ1,MDZNA
    213222 . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
    214223 . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
     
    216225 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
    217226 . . . 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
    222250 N MEDTMP,MEDI
    223251 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
Note: See TracChangeset for help on using the changeset viewer.