Changeset 1206 for ccr/trunk/p/C0CMED2.m


Ignore:
Timestamp:
Jul 15, 2011, 4:47:06 PM (13 years ago)
Author:
George Lilly
Message:

removed tabs after certification

File:
1 edited

Legend:

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

    r1204 r1206  
    1 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
    2         ;;1.0;C0C;;May 19, 2009;Build 38
    3         ;;Last Modified Sat Jan 10 21:41:14 PST 2009
    4         ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    5         ; General Public License See attached copy of the License.
    6         ;
    7         ; This program is free software; you can redistribute it and/or modify
    8         ; it under the terms of the GNU General Public License as published by
    9         ; the Free Software Foundation; either version 2 of the License, or
    10         ; (at your option) any later version.
    11         ;
    12         ; This program is distributed in the hope that it will be useful,
    13         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    14         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15         ; GNU General Public License for more details.
    16         ;
    17         ; You should have received a copy of the GNU General Public License along
    18         ; with this program; if not, write to the Free Software Foundation, Inc.,
    19         ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20         ;
    21         W "NO ENTRY FROM TOP",!
    22         Q
    23         ;
    24 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT)               ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
    25         ;
    26         ; MINXML is the Input XML Template, passed by name
    27         ; DFN is Patient IEN (by Value)
    28         ; OUTXML is the resultant XML (by Name)
    29         ; MEDCOUNT is the current count of extracted meds, passed by Reference
    30         ;
    31         ; MEDS is return array from RPC.
    32         ; MAP is a mapping variable map (store result) for each med
    33         ; MED is holds each array element from MEDS, one medicine
    34         ;
    35         ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
    36         ; meds data available.
    37         ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
    38         ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
    39         ; File for pending meds is 52.41
    40         ; Unfortuantely, API does not supply us with any useful info beyond
    41         ; the IEN in 52.41, and the Med Name, and route.
    42         ; So, most of the info is going to get pulled from 52.41.
    43         N MEDS,MAP
    44         K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
    45         D PEN^PSO5241(DFN,"CCDCCR")
    46         M MEDS=^TMP($J,"CCDCCR",DFN)
    47         ; @(0) contains the number of meds or -1^NO DATA FOUND
    48         ; If it is -1, we quit.
    49         I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
    50         ZWRITE:$G(DEBUG) MEDS
    51         N RXIEN S RXIEN=0
    52         N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
    53         F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
    54         . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
    55         . S MEDCOUNT=MEDCOUNT+1
    56         . I DEBUG W "RXIEN IS ",RXIEN,!
    57         . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
    58         . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
    59         . I DEBUG W "MAP= ",MAP,!
    60         . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
    61         . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
    62         . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
    63         . S @MAP@("MEDISSUEDATETXT")="Issue Date"
    64         . ; Field 6 is "Effective date", and we pull it in timson format w/ I
    65         . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
    66         . ; Med never filled; next 4 fields are not applicable.
    67         . S @MAP@("MEDLASTFILLDATETXT")=""
    68         . S @MAP@("MEDLASTFILLDATE")=""
    69         . S @MAP@("MEDRXNOTXT")=""
    70         . S @MAP@("MEDRXNO")=""
    71         . S @MAP@("MEDTYPETEXT")="Medication"
    72         . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
    73         . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
    74         . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
    75         . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
    76         . ; NDC not supplied in API, but is rather trivial to obtain
    77         . ; MED(11) piece 1 has the IEN of the drug (file 50)
    78         . ; IEN is field 31 in the drug file.
    79         . ;
    80         . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
    81         . ; It is not defined when a dose in not chosen in CPRS. There is a long
    82         . ; series of fields that depend on it. We will use If and Else to deal
    83         . ; with that
    84         . N MEDIEN S MEDIEN=$P(MED(11),U)
    85         . I +MEDIEN>0 D  ; start of if/else block
    86         . . ; 12/30/08: I will be using RxNorm for coding...
    87         . . ; 176.001 is the file for Concepts; 176.003 is the file for
    88         . . ; sources (i.e. for RxNorm Version)
    89         . . ;
    90         . . ; We need the VUID first for the National Drug File entry first
    91         . . ; We get the VUID of the drug, by looking up the VA Product entry
    92         . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
    93         . . ; Field 99.99 is the VUID.
    94         . . ;
    95         . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
    96         . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
    97         . . ; $$GET1^DIQ.
    98         . . ;
    99         . . ; I get the RxNorm name and version from the RxNorm Sources (file
    100         . . ; 176.003), by searching for "RXNORM", then get the data.
    101         . . D NDF^PSS50(MEDIEN,,,,,"NDF")
    102         . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
    103         . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
    104         . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
    105         . . ;
    106         . . ; NDFIEN is not necessarily defined; it won't be if the drug
    107         . . ; is not matched to the national drug file (e.g. if the drug is
    108         . . ; new on the market, compounded, or is a fake drug [blue pill].
    109         . . ; To protect against failure, I will put an if/else block
    110         . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
    111         . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
    112         . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
    113         . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
    114         . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
    115         . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
    116         . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
    117         . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
    118         . . ;
    119         . . E  S (RXNORM,RXNNAME,RXNVER)=""
    120         . . ; End if/else block
    121         . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
    122         . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
    123         . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
    124         . . ;
    125         . . S @MAP@("MEDBRANDNAMETEXT")=""
    126         . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
    127         . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
    128         . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
    129         . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
    130         . . ; Units, concentration, etc, come from another call
    131         . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
    132         . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
    133         . . ; NDF Entry IEN, and VA Product Name
    134         . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
    135         . . ; Documented in the same manual; executed above.
    136         . . N CONCDATA
    137         . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
    138         . . ; and this will crash the call. So...
    139         . . I NDFIEN="" S CONCDATA=""
    140         . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
    141         . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
    142         . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
    143         . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
    144         . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
    145         . . ; Oddly, there is no easy place to find the dispense unit.
    146         . . ; It's not included in the original call, so we have to go to the drug file.
    147         . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
    148         . . ; Node 14.5 is the Dispense Unit
    149         . . D DATA^PSS50(MEDIEN,,,,,"QTY")
    150         . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
    151         . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
    152         . E  D
    153         . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
    154         . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
    155         . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
    156         . . S @MAP@("MEDBRANDNAMETEXT")=""
    157         . . S @MAP@("MEDSTRENGTHVALUE")=""
    158         . . S @MAP@("MEDSTRENGTHUNIT")=""
    159         . . S @MAP@("MEDFORMTEXT")=""
    160         . . S @MAP@("MEDCONCVALUE")=""
    161         . . S @MAP@("MEDCONCUNIT")=""
    162         . . S @MAP@("MEDSIZETEXT")=""
    163         . . S @MAP@("MEDQUANTITYVALUE")=""
    164         . . S @MAP@("MEDQUANTITYUNIT")=""
    165         . ; end of if/else block
    166         . ;
    167         . ; --- START OF DIRECTIONS ---
    168         . ; Sig data is not in any API. We obtain it using the IEN from
    169         . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
    170         . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
    171         . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
    172         . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
    173         . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
    174         . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
    175         . ; DIRNUM will be first piece for IEN.
    176         . ; DIRNUM is the proper Sigline numer.
    177         . ; SIGDATA is the simplfied array. Subscripts are really field numbers
    178         . ; in subfile 52.413.
    179         . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
    180         . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
    181         . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
    182         . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
    183         . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
    184         . . ; If this is an order for a refill; it's not really a new order; move on to next
    185         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
    186         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
    187         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
    188         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
    189         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
    190         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
    191         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
    192         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
    193         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
    194         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
    195         . . ; Invervals... again another call.
    196         . . ; The schedule is a free text field
    197         . . ; However, it gets translated by a call to the administration
    198         . . ; schedule file to see if that schedule exists.
    199         . . ; That's the same thing I am going to do.
    200         . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
    201         . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
    202         . . ; I looked), PSSFT is the name,
    203         . . ; and list is the ^TMP name to store the data in.
    204         . . ; Also, freqency may have "PRN" in it, so strip that out
    205         . . N FREQ S FREQ=SIGDATA(1)
    206         . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
    207         . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
    208         . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
    209         . . N INTERVAL
    210         . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
    211         . . E  D
    212         . . . N SUB S SUB=$O(SCHEDATA(0))
    213         . . . S INTERVAL=SCHEDATA(SUB,2)
    214         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
    215         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
    216         . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
    217         . . N DUR S DUR=SIGDATA(2)
    218         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
    219         . . N DURUNIT S DURUNIT=$E(DUR)
    220         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
    221         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
    222         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
    223         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
    224         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
    225         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
    226         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
    227         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
    228         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
    229         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
    230         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
    231         . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
    232         . ;
    233         . ; --- END OF DIRECTIONS ---
    234         . ;
    235         . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
    236         . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
    237         . ; W @MAP@("MEDPTINSTRUCTIONS"),!
    238         . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
    239         . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
    240         . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
    241         . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
    242         . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
    243         . K @RESULT
    244         . D MAP^C0CXPATH(MINXML,MAP,RESULT)
    245         . ; D PARY^C0CXPATH(RESULT)
    246         . ; MAPPING DIRECTIONS
    247         . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
    248         . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
    249         . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
    250         . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
    251         . ; N MDZ1,MDZNA
    252         . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
    253         . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
    254         . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
    255         . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
    256         . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
    257         . I MEDFIRST D  ;
    258         . . S MEDFIRST=0 ; RESET FIRST FLAG
    259         . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
    260         . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER
    261         N MEDTMP,MEDI
    262         D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
    263         I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
    264         . W "Pending Medication MISSING ",!
    265         . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
    266         Q
    267         ;
     1C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
     2 ;;1.0;C0C;;May 19, 2009;Build 38
     3 ;;Last Modified Sat Jan 10 21:41:14 PST 2009
     4 ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
     5 ; General Public License See attached copy of the License.
     6 ;
     7 ; This program is free software; you can redistribute it and/or modify
     8 ; it under the terms of the GNU General Public License as published by
     9 ; the Free Software Foundation; either version 2 of the License, or
     10 ; (at your option) any later version.
     11 ;
     12 ; This program is distributed in the hope that it will be useful,
     13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15 ; GNU General Public License for more details.
     16 ;
     17 ; You should have received a copy of the GNU General Public License along
     18 ; with this program; if not, write to the Free Software Foundation, Inc.,
     19 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20 ;
     21 W "NO ENTRY FROM TOP",!
     22 Q
     23 ;
     24EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
     25 ;
     26 ; MINXML is the Input XML Template, passed by name
     27 ; DFN is Patient IEN (by Value)
     28 ; OUTXML is the resultant XML (by Name)
     29 ; MEDCOUNT is the current count of extracted meds, passed by Reference
     30 ;
     31 ; MEDS is return array from RPC.
     32 ; MAP is a mapping variable map (store result) for each med
     33 ; MED is holds each array element from MEDS, one medicine
     34 ;
     35 ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
     36 ; meds data available.
     37 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
     38 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
     39 ; File for pending meds is 52.41
     40 ; Unfortuantely, API does not supply us with any useful info beyond
     41 ; the IEN in 52.41, and the Med Name, and route.
     42 ; So, most of the info is going to get pulled from 52.41.
     43 N MEDS,MAP
     44 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
     45 D PEN^PSO5241(DFN,"CCDCCR")
     46 M MEDS=^TMP($J,"CCDCCR",DFN)
     47 ; @(0) contains the number of meds or -1^NO DATA FOUND
     48 ; If it is -1, we quit.
     49 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
     50 ZWRITE:$G(DEBUG) MEDS
     51 N RXIEN S RXIEN=0
     52 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
     53 F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
     54 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
     55 . S MEDCOUNT=MEDCOUNT+1
     56 . I DEBUG W "RXIEN IS ",RXIEN,!
     57 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
     58 . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
     59 . I DEBUG W "MAP= ",MAP,!
     60 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
     61 . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
     62 . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
     63 . S @MAP@("MEDISSUEDATETXT")="Issue Date"
     64 . ; Field 6 is "Effective date", and we pull it in timson format w/ I
     65 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
     66 . ; Med never filled; next 4 fields are not applicable.
     67 . S @MAP@("MEDLASTFILLDATETXT")=""
     68 . S @MAP@("MEDLASTFILLDATE")=""
     69 . S @MAP@("MEDRXNOTXT")=""
     70 . S @MAP@("MEDRXNO")=""
     71 . S @MAP@("MEDTYPETEXT")="Medication"
     72 . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
     73 . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
     74 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
     75 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
     76 . ; NDC not supplied in API, but is rather trivial to obtain
     77 . ; MED(11) piece 1 has the IEN of the drug (file 50)
     78 . ; IEN is field 31 in the drug file.
     79 . ;
     80 . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
     81 . ; It is not defined when a dose in not chosen in CPRS. There is a long
     82 . ; series of fields that depend on it. We will use If and Else to deal
     83 . ; with that
     84 . N MEDIEN S MEDIEN=$P(MED(11),U)
     85 . I +MEDIEN>0 D  ; start of if/else block
     86 . . ; 12/30/08: I will be using RxNorm for coding...
     87 . . ; 176.001 is the file for Concepts; 176.003 is the file for
     88 . . ; sources (i.e. for RxNorm Version)
     89 . . ;
     90 . . ; We need the VUID first for the National Drug File entry first
     91 . . ; We get the VUID of the drug, by looking up the VA Product entry
     92 . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
     93 . . ; Field 99.99 is the VUID.
     94 . . ;
     95 . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
     96 . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
     97 . . ; $$GET1^DIQ.
     98 . . ;
     99 . . ; I get the RxNorm name and version from the RxNorm Sources (file
     100 . . ; 176.003), by searching for "RXNORM", then get the data.
     101 . . D NDF^PSS50(MEDIEN,,,,,"NDF")
     102 . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
     103 . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
     104 . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
     105 . . ;
     106 . . ; NDFIEN is not necessarily defined; it won't be if the drug
     107 . . ; is not matched to the national drug file (e.g. if the drug is
     108 . . ; new on the market, compounded, or is a fake drug [blue pill].
     109 . . ; To protect against failure, I will put an if/else block
     110 . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
     111 . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
     112 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
     113 . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
     114 . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
     115 . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
     116 . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
     117 . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
     118 . . ;
     119 . . E  S (RXNORM,RXNNAME,RXNVER)=""
     120 . . ; End if/else block
     121 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
     122 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
     123 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
     124 . . ;
     125 . . S @MAP@("MEDBRANDNAMETEXT")=""
     126 . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
     127 . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
     128 . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
     129 . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
     130 . . ; Units, concentration, etc, come from another call
     131 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
     132 . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
     133 . . ; NDF Entry IEN, and VA Product Name
     134 . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
     135 . . ; Documented in the same manual; executed above.
     136 . . N CONCDATA
     137 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
     138 . . ; and this will crash the call. So...
     139 . . I NDFIEN="" S CONCDATA=""
     140 . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
     141 . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
     142 . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
     143 . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
     144 . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
     145 . . ; Oddly, there is no easy place to find the dispense unit.
     146 . . ; It's not included in the original call, so we have to go to the drug file.
     147 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
     148 . . ; Node 14.5 is the Dispense Unit
     149 . . D DATA^PSS50(MEDIEN,,,,,"QTY")
     150 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
     151 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
     152 . E  D
     153 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
     154 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
     155 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
     156 . . S @MAP@("MEDBRANDNAMETEXT")=""
     157 . . S @MAP@("MEDSTRENGTHVALUE")=""
     158 . . S @MAP@("MEDSTRENGTHUNIT")=""
     159 . . S @MAP@("MEDFORMTEXT")=""
     160 . . S @MAP@("MEDCONCVALUE")=""
     161 . . S @MAP@("MEDCONCUNIT")=""
     162 . . S @MAP@("MEDSIZETEXT")=""
     163 . . S @MAP@("MEDQUANTITYVALUE")=""
     164 . . S @MAP@("MEDQUANTITYUNIT")=""
     165 . ; end of if/else block
     166 . ;
     167 . ; --- START OF DIRECTIONS ---
     168 . ; Sig data is not in any API. We obtain it using the IEN from
     169 . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
     170 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
     171 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
     172 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
     173 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
     174 . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
     175 . ; DIRNUM will be first piece for IEN.
     176 . ; DIRNUM is the proper Sigline numer.
     177 . ; SIGDATA is the simplfied array. Subscripts are really field numbers
     178 . ; in subfile 52.413.
     179 . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
     180 . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
     181 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
     182 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
     183 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
     184 . . ; If this is an order for a refill; it's not really a new order; move on to next
     185 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
     186 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
     187 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
     188 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
     189 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
     190 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
     191 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
     192 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
     193 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
     194 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
     195 . . ; Invervals... again another call.
     196 . . ; The schedule is a free text field
     197 . . ; However, it gets translated by a call to the administration
     198 . . ; schedule file to see if that schedule exists.
     199 . . ; That's the same thing I am going to do.
     200 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
     201 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
     202 . . ; I looked), PSSFT is the name,
     203 . . ; and list is the ^TMP name to store the data in.
     204 . . ; Also, freqency may have "PRN" in it, so strip that out
     205 . . N FREQ S FREQ=SIGDATA(1)
     206 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
     207 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
     208 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
     209 . . N INTERVAL
     210 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
     211 . . E  D
     212 . . . N SUB S SUB=$O(SCHEDATA(0))
     213 . . . S INTERVAL=SCHEDATA(SUB,2)
     214 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
     215 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
     216 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
     217 . . N DUR S DUR=SIGDATA(2)
     218 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
     219 . . N DURUNIT S DURUNIT=$E(DUR)
     220 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
     221 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
     222 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
     223 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
     224 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
     225 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
     226 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
     227 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
     228 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
     229 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
     230 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
     231 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
     232 . ;
     233 . ; --- END OF DIRECTIONS ---
     234 . ;
     235 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
     236 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
     237 . ; W @MAP@("MEDPTINSTRUCTIONS"),!
     238 . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
     239 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
     240 . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
     241 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
     242 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
     243 . K @RESULT
     244 . D MAP^C0CXPATH(MINXML,MAP,RESULT)
     245 . ; D PARY^C0CXPATH(RESULT)
     246 . ; MAPPING DIRECTIONS
     247 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
     248 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
     249 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
     250 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
     251 . ; N MDZ1,MDZNA
     252 . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
     253 . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
     254 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
     255 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
     256 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
     257 . I MEDFIRST D  ;
     258 . . S MEDFIRST=0 ; RESET FIRST FLAG
     259 . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
     260 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER
     261 N MEDTMP,MEDI
     262 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
     263 I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
     264 . W "Pending Medication MISSING ",!
     265 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
     266 Q
     267 ;
Note: See TracChangeset for help on using the changeset viewer.