Changeset 1544 for ccr/trunk/p/C0CMED3.m


Ignore:
Timestamp:
Oct 1, 2012, 9:32:46 PM (12 years ago)
Author:
Sam Habiel
Message:

Merged Routines in OHUM branch back in main tree

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p

  • ccr/trunk/p/C0CMED3.m

    r1336 r1544  
    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.2;C0C;;May 11, 2012;Build 47
     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.