Changeset 118 for ccr/trunk


Ignore:
Timestamp:
Aug 29, 2008, 6:11:36 PM (16 years ago)
Author:
Sam Habiel
Message:

Updated CCRMEDS

File:
1 edited

Legend:

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

    r103 r118  
    1 CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
    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(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
    24    ;
    25    ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    26    ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION 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    ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
    34    ; med data available.
    35    ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
    36    ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
    37 
    38    N MEDS,MAP
    39    K ^TMP($J)
    40    D RX^PSO52API(DFN,"CCDCCR")
    41    M MEDS=^TMP($J,"CCDCCR",DFN)
    42    ; @(0) contains the number of meds.
    43    ; If there are no meds (@(0)=0), we quit.
    44    I 'MEDS(0) S @OUTXML@(0)=0 QUIT 
    45    I DEBUG ZWR MEDS
    46    N RXIEN S RXIEN=0
    47    F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
    48    . I DEBUG W "RXIEN IS ",RXIEN,!
    49    . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J))
    50    . K @MAP
    51    . I DEBUG W "MAP= ",MAP,!
    52    . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
    53    . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
    54    . S @MAP@("MEDISSUEDATETXT")="Issue Date"
    55    . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
    56    . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
    57    . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
    58    . S @MAP@("MEDRXNOTXT")="Prescription Number"
    59    . S @MAP@("MEDRXNO")=MED(.01)
    60    . S @MAP@("MEDTYPETEXT")="Medication"
    61    . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
    62    . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
    63    . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
    64    . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
    65    . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
    66    . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
    67    . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
    68    . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
    69    . N MEDIEN S MEDIEN=$P(MED(6),U)
    70    . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
    71    . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
    72    . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
    73    . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
    74    . S @MAP@("MEDFORMTEXT")=$P(MED("OI"),U,4)
    75    . S @MAP@("MEDCONCVALUE")
    76    . S @MAP@("MEDCONCUNIT")
    77    . S @MAP@("MEDSIZETEXT")
    78    . S @MAP@("MEDQUANTITYVALUE")
    79    . S @MAP@("MEDQUANTITYUNIT")
    80    . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")
    81    . S @MAP@("MEDDOSEINDICATOR")
    82    . S @MAP@("MEDDELIVERYMETHOD")
    83    . S @MAP@("MEDDOSEVALUE")
    84    . S @MAP@("MEDDOSEUNIT")
    85    . S @MAP@("MEDRATEVALUE")
    86    . S @MAP@("MEDRATEUNIT")
    87    . S @MAP@("MEDVEHICLETEXT")
    88    . S @MAP@("MEDDIRECTIONROUTETEXT")
    89    . S @MAP@("MEDFREQUENCYVALUE")
    90    . S @MAP@("MEDFREQUENCYUNIT")
    91    . S @MAP@("MEDINTERVALVALUE")
    92    . S @MAP@("MEDINTERVALUNIT")
    93    . S @MAP@("MEDDURATIONVALUE")
    94    . S @MAP@("MEDDURATIONUNIT")
    95    . S @MAP@("MEDPRNFLAG")
    96    . S @MAP@("MEDPROBLEMOBJECTID")=""
    97    . S @MAP@("MEDPROBLEMDESCRIPTION")=""
    98    . S @MAP@("MEDPROBLEMCODEVALUE")=""
    99    . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
    100    . S @MAP@("MEDPROBLEMCODINGVERSION")=""
    101    . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
    102    . S @MAP@("MEDSTOPINDICATOR")
    103    . S @MAP@("MEDDIRSEQ")
    104    . S @MAP@("MEDMULDIRMOD")
    105    . S @MAP@("MEDPTINSTRUCTIONS")
    106    . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")
    107    . S @MAP@("MEDRFNO")
    108    . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J))
    109    . K @RESULT
    110    . D MAP^GPLXPATH(INXML,MAP,RESULT)
    111    . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
    112    . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
    113    N MEDTMP,MEDI
    114    D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
    115    I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
    116    . W "MEDICATION MISSING ",!
    117    . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
    118    Q
    119    ;
     1CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
     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          ;
     23EXTRACT(INXML,DFN,OUTXML)       ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
     24          ;
     25          ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     26          ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION 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          ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
     34          ; med data available.
     35          ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
     36          ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
     37       
     38          N MEDS,MAP
     39          K ^TMP($J)
     40          D RX^PSO52API(DFN,"CCDCCR")
     41          M MEDS=^TMP($J,"CCDCCR",DFN)
     42          ; @(0) contains the number of meds or -1^NO DATA FOUND
     43          ; If it is -1, we quit.
     44          I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 
     45          I DEBUG ZWR MEDS
     46          N RXIEN S RXIEN=0
     47          F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
     48          . I DEBUG W "RXIEN IS ",RXIEN,!
     49          . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J))
     50          . K @MAP
     51          . I DEBUG W "MAP= ",MAP,!
     52          . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
     53          . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
     54          . S @MAP@("MEDISSUEDATETXT")="Issue Date"
     55          . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
     56          . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
     57          . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
     58          . S @MAP@("MEDRXNOTXT")="Prescription Number"
     59          . S @MAP@("MEDRXNO")=MED(.01)
     60          . S @MAP@("MEDTYPETEXT")="Medication"
     61          . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
     62          . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
     63          . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
     64          . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
     65          . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
     66          . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
     67          . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
     68          . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
     69          . N MEDIEN S MEDIEN=$P(MED(6),U)
     70          . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
     71          . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
     72          . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
     73          . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
     74          . ; Units, concentration, etc, come from another call
     75          . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
     76          . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
     77          . ; NDF Entry IEN, and VA Product Name
     78          . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
     79          . ; Documented in the same manual.
     80          . N IEN S IEN=^PSDRUG($P(MED(6),U))
     81          . D NDF^PSS50(IEN,,,,,"CONC")
     82          . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN)
     83          . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
     84          . N VAPROD S VAPROD=$P(NDFDATA(22),U)
     85          . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
     86          . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
     87          . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
     88          . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
     89          . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
     90          . S @MAP@("MEDQUANTITYVALUE")=MED(7)
     91          . ; Oddly, there is no easy place to find the dispense unit.
     92          . ; It's not included in the original call, so we have to go to the drug file.
     93          . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
     94          . ; Node 14.5 is the Dispense Unit
     95          . D DATA^PSS50(IEN,,,,,"QTY")
     96          . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN)
     97          . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
     98          . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""
     99          . S @MAP@("MEDDOSEINDICATOR")
     100          . S @MAP@("MEDDELIVERYMETHOD")
     101          . S @MAP@("MEDDOSEVALUE")
     102          . S @MAP@("MEDDOSEUNIT")
     103          . S @MAP@("MEDRATEVALUE")
     104          . S @MAP@("MEDRATEUNIT")
     105          . S @MAP@("MEDVEHICLETEXT")
     106          . S @MAP@("MEDDIRECTIONROUTETEXT")
     107          . S @MAP@("MEDFREQUENCYVALUE")
     108          . S @MAP@("MEDFREQUENCYUNIT")
     109          . S @MAP@("MEDINTERVALVALUE")
     110          . S @MAP@("MEDINTERVALUNIT")
     111          . S @MAP@("MEDDURATIONVALUE")
     112          . S @MAP@("MEDDURATIONUNIT")
     113          . S @MAP@("MEDPRNFLAG")
     114          . S @MAP@("MEDPROBLEMOBJECTID")=""
     115          . S @MAP@("MEDPROBLEMDESCRIPTION")=""
     116          . S @MAP@("MEDPROBLEMCODEVALUE")=""
     117          . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
     118          . S @MAP@("MEDPROBLEMCODINGVERSION")=""
     119          . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
     120          . S @MAP@("MEDSTOPINDICATOR")
     121          . S @MAP@("MEDDIRSEQ")
     122          . S @MAP@("MEDMULDIRMOD")
     123          . S @MAP@("MEDPTINSTRUCTIONS")
     124          . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")
     125          . S @MAP@("MEDRFNO")=MED(9)
     126          . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J))
     127          . K @RESULT
     128          . D MAP^GPLXPATH(INXML,MAP,RESULT)
     129          . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
     130          . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
     131          N MEDTMP,MEDI
     132          D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
     133          I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
     134          . W "MEDICATION MISSING ",!
     135          . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
     136          Q
     137          ;
Note: See TracChangeset for help on using the changeset viewer.