Changeset 685 for ccr/trunk

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:

• ccr/trunk/p/C0CMED3.m (modified) (7 diffs)

ccr/trunk/p/C0CMED3.m

@@ -49 +49 @@
  K NVA
  ;
- I DEBUG ZWR MEDS
+ I DEBUG ZWRITE MEDS
  N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
  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
  . . ; 176.003), by searching for "RXNORM", then get the data.
- . . D NDF^PSS50(MEDIEN,,,,,"NDF")
- . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
- . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
- . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . . ; NDF^PSS50 ONLY EXISTS ON VISTA
+ . . N NDFDATA,NDFIEN,VAPROD
+ . . S NDFIEN=""
+ . . I '$$RPMS^C0CUTIL() D
+ . . . D NDF^PSS50(MEDIEN,,,,,"NDF")
+ . . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+ . . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+ . . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . . . M NDFDATA=^TMP($J,"NDF",MEDIEN)
+ . . . S NDFIEN=$P(NDFDATA(20),U)
+ . . . S VAPROD=$P(NDFDATA(22),U)
  . . ;
  . . ; NDFIEN is not necessarily defined; it won't be if the drug
@@ -119 +126 @@
  . . ;
  . . S @MAP@("MEDBRANDNAMETEXT")=""
- . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
- . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
- . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
- . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+ . . ; DOSE^PSS50 ONLY ESISTS ON VISTA
+ . . I '$$RPMS^C0CUTIL() D
+ . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+ . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+ . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+ . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+ . . E  S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
  . . ; Units, concentration, etc, come from another call
  . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
@@ -142 +152 @@
  . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
  . . ; Node 14.5 is the Dispense Unit
- . . D DATA^PSS50(MEDIEN,,,,,"QTY")
- . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
- . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . . ; PSS50 ONLY EXISTS ON VISTA
+ . . I '$$RPMS^C0CUTIL() D
+ . . . D DATA^PSS50(MEDIEN,,,,,"QTY")
+ . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . . E  S @MAP@("MEDQUANTITYUNIT")=""
  . E  D
  . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
@@ -193 +206 @@
  . ; --- END OF DIRECTIONS ---
  . ;
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
- . I $D(MED(10,1)) D  ;
- . . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
- . E  S @MAP@("MEDPTINSTRUCTIONS")=""
+ . S @MAP@("MEDRFNO")=""
  . I $D(MED(14,1)) D  ;
  . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
  . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
- . S @MAP@("MEDRFNO")=""
  . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
  . K @RESULT
@@ -210 +219 @@
  . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
  . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
- . ; N MDZ1,MDZNA
+ . N MDZ1,MDZNA
  . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
  . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
@@ -216 +225 @@
  . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
  . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
- . I MEDFIRST D  ;
- . . S MEDFIRST=0 ; RESET FIRST FLAG
- . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
- . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ . ;
+ . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
+ . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
+ . N MDI1
+ . S MDI1=$NA(@MAP@("I"))
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . I $D(MED(10,1)) D  ;
+ . . S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
+ . E  S @MAP@("I","MEDPTINSTRUCTIONS")=""
+ . D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
+ . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
+ . ;
+ . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
+ . ;I MEDFIRST D  ;
+ . ;. S MEDFIRST=0 ; RESET FIRST FLAG
+ . ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ . I MEDFIRST S MEDFIRST=0
  N MEDTMP,MEDI
  D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS