Changeset 1206 for ccr/trunk/p/C0CMED3.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/C0CMED3.m

    r1205 r1206  
    1 C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
    2         ;;1.0;C0C;;May 19, 2009;Build 38
    3         ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
    4         ; Copyright 2009 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 (passed by value)
    28         ; OUTXML is the resultant XML (passed by name)
    29         ; MEDCOUNT is the number of Meds extracted so far (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         ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
    36         ; Discontinued meds are indicated by the presence of a value in fields
    37         ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
    38         ; Will use Fileman API GETS^DIQ
    39         ;
    40         N MEDS,MAP
    41         K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
    42         N NVA
    43         D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
    44         ; If NVA does not exist, then patient has no non-VA meds
    45         I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
    46         ; Otherwise, we go on...
    47         M MEDS=NVA(55.05)
    48         ; We are done with NVA
    49         K NVA
    50         ;
    51         I DEBUG ZWRITE MEDS
    52         N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
    53         N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
    54         F  S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
    55         . N MED M MED=MEDS(FDAIEN)
    56         . I MED(5,"I")!MED(6,"I") QUIT  ; If disconinued, we don't want to pull it.
    57         . S MEDCOUNT=MEDCOUNT+1
    58         . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
    59         . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
    60         . I DEBUG W "RXIEN IS ",RXIEN,!
    61         . I DEBUG W "MAP= ",MAP,!
    62         . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
    63         . S @MAP@("MEDISSUEDATETXT")="Documented Date"
    64         . ; Field 6 is "Effective date", and we pull it in timson format w/ I
    65         . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"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")="Active" ; nearest status for pending meds
    74         . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
    75         . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
    76         . ; NDC is field 31 in the drug file.
    77         . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
    78         . ; It' node 1, internal form.
    79         . N MEDIEN S MEDIEN=MED(1,"I")
    80         . I +MEDIEN D  ; start of if/else block
    81         . . ; 12/30/08: I will be using RxNorm for coding...
    82         . . ; 176.001 is the file for Concepts; 176.003 is the file for
    83         . . ; sources (i.e. for RxNorm Version)
    84         . . ;
    85         . . ; We need the VUID first for the National Drug File entry first
    86         . . ; We get the VUID of the drug, by looking up the VA Product entry
    87         . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
    88         . . ; Field 99.99 is the VUID.
    89         . . ;
    90         . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
    91         . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
    92         . . ; $$GET1^DIQ.
    93         . . ;
    94         . . ; I get the RxNorm name and version from the RxNorm Sources (file
    95         . . ; 176.003), by searching for "RXNORM", then get the data.
    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)
    107         . . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ;
    108         . . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE
    109         . . ;   HAVE IT.
    110         . . ;
    111         . . ; NDFIEN is not necessarily defined; it won't be if the drug
    112         . . ; is not matched to the national drug file (e.g. if the drug is
    113         . . ; new on the market, compounded, or is a fake drug [blue pill].
    114         . . ; To protect against failure, I will put an if/else block
    115         . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
    116         . . ;
    117         . . ; begin changes for systems that have eRx installed
    118         . . ; RxNorm is found in the ^C0P("RXN") global - gpl
    119         . . ;
    120         . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
    121         . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
    122         . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE
    123         . . I NDFIEN,$D(^C0P("RXN")) D  ;
    124         . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
    125         . . . S ZC=$$CODE^C0CUTIL(VUID)
    126         . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
    127         . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
    128         . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
    129         . . . S RXNORM=ZCD ; THE CODE
    130         . . . S RXNNAME=ZCDS ; THE CODING SYSTEM
    131         . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION
    132         . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
    133         . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD
    134         . . E  I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
    135         . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
    136         . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
    137         . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
    138         . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
    139         . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
    140         . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
    141         . . ;
    142         . . ;E  S (RXNORM,RXNNAME,RXNVER)=""
    143         . . ; End if/else block
    144         . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
    145         . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
    146         . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
    147         . . ;
    148         . . S @MAP@("MEDBRANDNAMETEXT")=""
    149         . . ; DOSE^PSS50 ONLY ESISTS ON VISTA
    150         . . I '$$RPMS^C0CUTIL() D
    151         . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
    152         . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
    153         . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
    154         . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
    155         . . E  S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
    156         . . ; Units, concentration, etc, come from another call
    157         . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
    158         . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
    159         . . ; NDF Entry IEN, and VA Product Name
    160         . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
    161         . . ; Documented in the same manual; executed above.
    162         . . ;
    163         . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
    164         . . ; and this will crash the call. So...
    165         . . I NDFIEN="" S CONCDATA=""
    166         . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
    167         . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
    168         . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
    169         . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
    170         . . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
    171         . . ; Oddly, there is no easy place to find the dispense unit.
    172         . . ; It's not included in the original call, so we have to go to the drug file.
    173         . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
    174         . . ; Node 14.5 is the Dispense Unit
    175         . . ; PSS50 ONLY EXISTS ON VISTA
    176         . . I '$$RPMS^C0CUTIL() D
    177         . . . D DATA^PSS50(MEDIEN,,,,,"QTY")
    178         . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
    179         . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
    180         . . E  S @MAP@("MEDQUANTITYUNIT")=""
    181         . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these
    182         . E  D
    183         . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
    184         . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
    185         . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
    186         . . S @MAP@("MEDBRANDNAMETEXT")=""
    187         . . S @MAP@("MEDSTRENGTHVALUE")=""
    188         . . S @MAP@("MEDSTRENGTHUNIT")=""
    189         . . S @MAP@("MEDFORMTEXT")=""
    190         . . S @MAP@("MEDCONCVALUE")=""
    191         . . S @MAP@("MEDCONCUNIT")=""
    192         . . S @MAP@("MEDSIZETEXT")=""
    193         . . S @MAP@("MEDQUANTITYVALUE")=""
    194         . . S @MAP@("MEDQUANTITYUNIT")=""
    195         . ; End If/Else
    196         . ; --- START OF DIRECTIONS ---
    197         . ; Dosage is field 2, route is 3, schedule is 4
    198         . ; These are all free text fields, and don't point to any files
    199         . ; For that reason, I will use the field I never used before:
    200         . ; MEDDIRECTIONDESCRIPTIONTEXT
    201         . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
    202         . ;
    203         . ; change for eRx meds - gpl 6/25/2011
    204         . ;
    205         . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
    206         . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME
    207         . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX
    208         . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity
    209         . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME
    210         . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D  ; FIX THE DRUG NAME
    211         . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME
    212         . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM
    213         . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY
    214         . . I RXNORM'="" D  ;
    215         . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM
    216         . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM
    217         . . . S RXNVER="" ; THE CODING SYSTEM VERSION
    218         . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
    219         . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM
    220         . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
    221         . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
    222         . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
    223         . . . I RXNORM["979334" D  ; PATCH FOR CERTIFICATION
    224         . . . . S @MAP@("MEDSTRENGTHVALUE")=650
    225         . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"
    226         . . . . S @MAP@("MEDFORMTEXT")="INHALER"
    227         . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS
    228         . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY
    229         . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;
    230         . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
    231         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
    232         . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
    233         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
    234         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
    235         . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
    236         . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
    237         . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
    238         . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
    239         . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
    240         . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
    241         . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
    242         . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
    243         . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
    244         . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
    245         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
    246         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
    247         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
    248         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
    249         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
    250         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
    251         . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
    252         . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
    253         . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
    254         . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
    255         . ;
    256         . ; --- END OF DIRECTIONS ---
    257         . ;
    258         . S @MAP@("MEDRFNO")=""
    259         . I $D(MED(14,1)) D  ;
    260         . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
    261         . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
    262         . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl
    263         . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
    264         . K @RESULT
    265         . D MAP^C0CXPATH(MINXML,MAP,RESULT)
    266         . ; D PARY^C0CXPATH(RESULT)
    267         . ; MAPPING DIRECTIONS
    268         . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
    269         . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
    270         . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
    271         . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
    272         . N MDZ1,MDZNA
    273         . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
    274         . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
    275         . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
    276         . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
    277         . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
    278         . ;
    279         . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
    280         . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
    281         . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
    282         . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
    283         . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
    284         . ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010
    285         . ;S MDI1=$NA(@MAP@("I"))
    286         . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
    287         . I $D(MED(10,1)) D  ;
    288         . . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
    289         . . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
    290         . E  S @MAP@("MEDPTINSTRUCTIONS")=""
    291         . ;E  S @MAP@("I","MEDPTINSTRUCTIONS")=""
    292         . ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
    293         . D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL
    294         . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
    295         . ;
    296         . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
    297         . ;I MEDFIRST D  ;
    298         . ;. S MEDFIRST=0 ; RESET FIRST FLAG
    299         . ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
    300         . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
    301         . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
    302         . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
    303         . I MEDFIRST S MEDFIRST=0
    304         N MEDTMP,MEDI
    305         D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
    306         I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
    307         . W "MEDICATION MISSING ",!
    308         . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
    309         Q
    310         ;
     1C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
     2 ;;1.0;C0C;;May 19, 2009;Build 38
     3 ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
     4 ; Copyright 2009 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 (passed by value)
     28 ; OUTXML is the resultant XML (passed by name)
     29 ; MEDCOUNT is the number of Meds extracted so far (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 ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
     36 ; Discontinued meds are indicated by the presence of a value in fields
     37 ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
     38 ; Will use Fileman API GETS^DIQ
     39 ;
     40 N MEDS,MAP
     41 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
     42 N NVA
     43 D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
     44 ; If NVA does not exist, then patient has no non-VA meds
     45 I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
     46 ; Otherwise, we go on...
     47 M MEDS=NVA(55.05)
     48 ; We are done with NVA
     49 K NVA
     50 ;
     51 I DEBUG ZWRITE MEDS
     52 N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
     53 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
     54 F  S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
     55 . N MED M MED=MEDS(FDAIEN)
     56 . I MED(5,"I")!MED(6,"I") QUIT  ; If disconinued, we don't want to pull it.
     57 . S MEDCOUNT=MEDCOUNT+1
     58 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
     59 . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
     60 . I DEBUG W "RXIEN IS ",RXIEN,!
     61 . I DEBUG W "MAP= ",MAP,!
     62 . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
     63 . S @MAP@("MEDISSUEDATETXT")="Documented Date"
     64 . ; Field 6 is "Effective date", and we pull it in timson format w/ I
     65 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"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")="Active" ; nearest status for pending meds
     74 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
     75 . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
     76 . ; NDC is field 31 in the drug file.
     77 . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
     78 . ; It' node 1, internal form.
     79 . N MEDIEN S MEDIEN=MED(1,"I")
     80 . I +MEDIEN D  ; start of if/else block
     81 . . ; 12/30/08: I will be using RxNorm for coding...
     82 . . ; 176.001 is the file for Concepts; 176.003 is the file for
     83 . . ; sources (i.e. for RxNorm Version)
     84 . . ;
     85 . . ; We need the VUID first for the National Drug File entry first
     86 . . ; We get the VUID of the drug, by looking up the VA Product entry
     87 . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
     88 . . ; Field 99.99 is the VUID.
     89 . . ;
     90 . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
     91 . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
     92 . . ; $$GET1^DIQ.
     93 . . ;
     94 . . ; I get the RxNorm name and version from the RxNorm Sources (file
     95 . . ; 176.003), by searching for "RXNORM", then get the data.
     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)
     107 . . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ;
     108 . . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE
     109 . . ;   HAVE IT.
     110 . . ;
     111 . . ; NDFIEN is not necessarily defined; it won't be if the drug
     112 . . ; is not matched to the national drug file (e.g. if the drug is
     113 . . ; new on the market, compounded, or is a fake drug [blue pill].
     114 . . ; To protect against failure, I will put an if/else block
     115 . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
     116 . . ;
     117 . . ; begin changes for systems that have eRx installed
     118 . . ; RxNorm is found in the ^C0P("RXN") global - gpl
     119 . . ;
     120 . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
     121 . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
     122 . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE
     123 . . I NDFIEN,$D(^C0P("RXN")) D  ;
     124 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
     125 . . . S ZC=$$CODE^C0CUTIL(VUID)
     126 . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
     127 . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
     128 . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
     129 . . . S RXNORM=ZCD ; THE CODE
     130 . . . S RXNNAME=ZCDS ; THE CODING SYSTEM
     131 . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION
     132 . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
     133 . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD
     134 . . E  I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
     135 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
     136 . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
     137 . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
     138 . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
     139 . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
     140 . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
     141 . . ;
     142 . . ;E  S (RXNORM,RXNNAME,RXNVER)=""
     143 . . ; End if/else block
     144 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
     145 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
     146 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
     147 . . ;
     148 . . S @MAP@("MEDBRANDNAMETEXT")=""
     149 . . ; DOSE^PSS50 ONLY ESISTS ON VISTA
     150 . . I '$$RPMS^C0CUTIL() D
     151 . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
     152 . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
     153 . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
     154 . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
     155 . . E  S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
     156 . . ; Units, concentration, etc, come from another call
     157 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
     158 . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
     159 . . ; NDF Entry IEN, and VA Product Name
     160 . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
     161 . . ; Documented in the same manual; executed above.
     162 . . ;
     163 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
     164 . . ; and this will crash the call. So...
     165 . . I NDFIEN="" S CONCDATA=""
     166 . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
     167 . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
     168 . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
     169 . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
     170 . . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
     171 . . ; Oddly, there is no easy place to find the dispense unit.
     172 . . ; It's not included in the original call, so we have to go to the drug file.
     173 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
     174 . . ; Node 14.5 is the Dispense Unit
     175 . . ; PSS50 ONLY EXISTS ON VISTA
     176 . . I '$$RPMS^C0CUTIL() D
     177 . . . D DATA^PSS50(MEDIEN,,,,,"QTY")
     178 . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
     179 . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
     180 . . E  S @MAP@("MEDQUANTITYUNIT")=""
     181 . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these
     182 . E  D
     183 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
     184 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
     185 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
     186 . . S @MAP@("MEDBRANDNAMETEXT")=""
     187 . . S @MAP@("MEDSTRENGTHVALUE")=""
     188 . . S @MAP@("MEDSTRENGTHUNIT")=""
     189 . . S @MAP@("MEDFORMTEXT")=""
     190 . . S @MAP@("MEDCONCVALUE")=""
     191 . . S @MAP@("MEDCONCUNIT")=""
     192 . . S @MAP@("MEDSIZETEXT")=""
     193 . . S @MAP@("MEDQUANTITYVALUE")=""
     194 . . S @MAP@("MEDQUANTITYUNIT")=""
     195 . ; End If/Else
     196 . ; --- START OF DIRECTIONS ---
     197 . ; Dosage is field 2, route is 3, schedule is 4
     198 . ; These are all free text fields, and don't point to any files
     199 . ; For that reason, I will use the field I never used before:
     200 . ; MEDDIRECTIONDESCRIPTIONTEXT
     201 . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
     202 . ;
     203 . ; change for eRx meds - gpl 6/25/2011
     204 . ;
     205 . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
     206 . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME
     207 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX
     208 . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity
     209 . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME
     210 . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D  ; FIX THE DRUG NAME
     211 . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME
     212 . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM
     213 . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY
     214 . . I RXNORM'="" D  ;
     215 . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM
     216 . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM
     217 . . . S RXNVER="" ; THE CODING SYSTEM VERSION
     218 . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
     219 . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM
     220 . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
     221 . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
     222 . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
     223 . . . I RXNORM["979334" D  ; PATCH FOR CERTIFICATION
     224 . . . . S @MAP@("MEDSTRENGTHVALUE")=650
     225 . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"
     226 . . . . S @MAP@("MEDFORMTEXT")="INHALER"
     227 . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS
     228 . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY
     229 . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;
     230 . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
     231 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
     232 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
     233 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
     234 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
     235 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
     236 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
     237 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
     238 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
     239 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
     240 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
     241 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
     242 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
     243 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
     244 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
     245 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
     246 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
     247 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
     248 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
     249 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
     250 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
     251 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
     252 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
     253 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
     254 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
     255 . ;
     256 . ; --- END OF DIRECTIONS ---
     257 . ;
     258 . S @MAP@("MEDRFNO")=""
     259 . I $D(MED(14,1)) D  ;
     260 . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
     261 . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
     262 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl
     263 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
     264 . K @RESULT
     265 . D MAP^C0CXPATH(MINXML,MAP,RESULT)
     266 . ; D PARY^C0CXPATH(RESULT)
     267 . ; MAPPING DIRECTIONS
     268 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
     269 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
     270 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
     271 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
     272 . N MDZ1,MDZNA
     273 . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
     274 . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
     275 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
     276 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
     277 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
     278 . ;
     279 . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
     280 . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
     281 . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
     282 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
     283 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
     284 . ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010
     285 . ;S MDI1=$NA(@MAP@("I"))
     286 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
     287 . I $D(MED(10,1)) D  ;
     288 . . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
     289 . . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
     290 . E  S @MAP@("MEDPTINSTRUCTIONS")=""
     291 . ;E  S @MAP@("I","MEDPTINSTRUCTIONS")=""
     292 . ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
     293 . D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL
     294 . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
     295 . ;
     296 . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
     297 . ;I MEDFIRST D  ;
     298 . ;. S MEDFIRST=0 ; RESET FIRST FLAG
     299 . ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
     300 . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
     301 . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
     302 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
     303 . I MEDFIRST S MEDFIRST=0
     304 N MEDTMP,MEDI
     305 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
     306 I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
     307 . W "MEDICATION MISSING ",!
     308 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
     309 Q
     310 ;
Note: See TracChangeset for help on using the changeset viewer.