Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORNW2.m

    r613 r623  
    1 PSOORNW2        ;ISC-BHAM/SAB - edit orders from oerr ;9:45 AM  31 Dec 2008
    2         ;;7.0;OUTPATIENT PHARMACY;**10,23,37,46,117,131,133,148,222,269,206;208**;Build 41;Build 39;WorldVistA 30-Jan-08
    3         ;
    4         ;Modified from FOIA VISTA,
    5         ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    6         ;General Public License See attached copy of the License.
    7         ;
    8         ;This program is free software; you can redistribute it and/or modify
    9         ;it under the terms of the GNU General Public License as published by
    10         ;the Free Software Foundation; either version 2 of the License, or
    11         ;(at your option) any later version.
    12         ;
    13         ;This program is distributed in the hope that it will be useful,
    14         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    15         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16         ;GNU General Public License for more details.
    17         ;
    18         ;You should have received a copy of the GNU General Public License along
    19         ;with this program; if not, write to the Free Software Foundation, Inc.,
    20         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    21         ;
    22         ;Reference to ^YSCL(603.01 supported by DBIA 2697
    23         ;Reference to ^PS(55 supported by DBIA 2228
    24         ;Reference to ^PSDRUG( supported by DBIA 221
    25         ;Reference to ^PS(50.606 supported by DBIA 2174
    26         ;Reference to ^PS(50.7 supported by DBIA 2223
    27         ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
    28         ;
    29 1       I $G(PSODRUG("OI")) M:$G(PSOBDRG) PSOBDR=PSODRUG W !!,"Current Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
    30         S DIC("B")=$S($G(PSODRUG("OIN"))]"":PSODRUG("OIN"),1:""),DIC="^PS(50.7,",DIC(0)="AEMQZ"
    31         S DIC("S")="I '$P(^PS(50.7,+Y,0),""^"",4)!($P(^(0),""^"",4)'<DT) N PSOF,PSOL S (PSOF,PSOL)=0 F  S PSOL=$O(^PSDRUG(""ASP"",+Y,PSOL)) Q:PSOF!'PSOL  "
    32         S DIC("S")=DIC("S")_"I $P($G(^PSDRUG(PSOL,2)),U,3)[""O"",'$G(^(""I""))!($G(^(""I""))'<DT) S PSOF=1"
    33         ;BHW;PSO*7*269;Modify ^DIC call to call MIX^DIC to use only the B and C Cross-References.
    34         S D="B^C" D MIX^DIC1 K DIC,D I X["^"!($D(DTOUT)) S OUT=1 Q
    35         S PSOY=Y
    36         I +Y'=OI D  I 'Y!($D(DIRUT)) D KV,MP1^PSOOREDX K DIC,Y,PSOY S OUT=1 Q
    37         .D KV S DIR(0)="Y",DIR("B")="NO",DIR("A",1)="",DIR("A")="This edit will create a new order.  Do you want to continue" D ^DIR
    38         G:Y<1 1 S PSODRUG("OI")=+PSOY,PSODRUG("OIN")=$P(PSOY,"^",2),PSONEW("CLERK CODE")=DUZ D KV K DIC,PSOY
    39         N PSOIC S PSOIC=1 D DREN
    40         D 2^PSOORNEW Q
    41 4       S PSONEW("FLD")=1 D ISSDT^PSODIR2(.PSONEW) ; Issue Date
    42         I PSOID>PSONEW("FILL DATE") S PSONEW("FILL DATE")=PSOID,PSORX("FILL DATE")=PSORX("ISSUE DATE")
    43         Q
    44         ;
    45 5       S PSONEW("FLD")=2 D FILLDT^PSODIR2(.PSONEW) ; Fill date
    46         Q
    47         ;
    48 INS     S PSONEW("FLD")=114 D INS^PSODIR(.PSONEW) ; Pat Inst
    49         I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW)
    50         Q
    51         ;
    52 3       S PSONEW("FLD")=3 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status
    53         I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D  Q
    54         .S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:+$P(OR0,"^",11)),PSOMAX=+$P(^PS(53,RXPT,0),"^",4)
    55         .S PSOMAX=$S($G(PSOCS):5,1:11),PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX)
    56         .S PSONEW("# OF REFILLS")=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
    57         I $G(PSOMAX) S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11))
    58         I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F")!($G(PSODRUG("DEA"))[1)!($G(PSODRUG("DEA"))[2) D
    59         .S PSONEW("# OF REFILLS")=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
    60         Q
    61         ;
    62 12      S PSONEW("FLD")=4 D PROV^PSODIR(.PSONEW) ; Get Provider
    63         Q
    64         ;
    65 11      S PSONEW("FLD")=5 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic
    66         Q
    67         ;
    68 8       S PSONEW("FLD")=7 D QTY^PSODIR1(.PSONEW) ; Get quantity
    69         Q
    70         ;
    71 7       I '$G(PSODRUG("IEN")) W $C(7),!!,"No Dispense Drug!",! K DIR,DUOUT,DIRUT,DTOUT D 2^PSOORNW1
    72         I '$G(PSODRUG("IEN")) W !,$C(7),"No Dispense Drug Selected! A new Orderable Item may need to be selected.",! Q
    73         S PSONEW("FLD")=8 D DAYS^PSODIR1(.PSONEW) ; Get days supply
    74         Q:'$G(PSONEW("PATIENT STATUS"))
    75         K PSDY,PSDY1,PSMAX,PSTMAX S PSDAYS=PSONEW("DAYS SUPPLY"),PSRF=PSONEW("# OF REFILLS"),PTST=$P(^PS(53,PSONEW("PATIENT STATUS"),0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4),PSODEA=PSODRUG("DEA"),CS=0 ;D EDNEW^PSOORNW1
    76         Q
    77 9       ;
    78         I '$G(PSONEW("PATIENT STATUS")) W !!,"Rx Patient Status required!",! D 3 I '$G(PSONEW("PATIENT STATUS")) S VALMSG="Rx Patient Status required!",VALMBCK="R" Q
    79         I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D  G ASK
    80         .S PSOMAX=$S($G(CLOZPAT)=2:3,$G(CLOZPAT)=1:1,$G(CLOZPAT)=0:0,1:+$P(^PS(53,RXPT,0),"^",4)) K RXPT
    81         .S:'$G(PSONEW("# OF REFILLS")) PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11))
    82         .S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
    83         .I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F")!($G(PSODRUG("DEA"))[1)!($G(PSODRUG("DEA"))[2) D  Q
    84         ..S (PSOMAX,PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
    85         .I $D(PSODRUG("DEA")) F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)=""  I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S PSOMAX=5
    86         I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F")!($G(PSODRUG("DEA"))[1)!($G(PSODRUG("DEA"))[2) D  Q
    87         .S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
    88         S (PSONEW("N# REF"),PSOMAX,PSONEW("# OF REFILLS"))=+$P(OR0,"^",11)
    89 ASK     S PSONEW("FLD")=9 D REFILL^PSODIR1(.PSONEW) ; Get # of refills
    90         K PSOMAX,PSMAX,PSTMAX S PSDAYS=PSONEW("DAYS SUPPLY"),PSRF=PSONEW("# OF REFILLS"),PTST=$P(^PS(53,PSONEW("PATIENT STATUS"),0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4),PSODEA=$G(PSODRUG("DEA")),CS=0 D EDNEW^PSOORNW1
    91         Q
    92         ;
    93 6       Q  K DA S PSONEW("FLD")=10 D SIG^PSODIR1(.PSONEW) ; Get sig
    94         I $G(PSONEW("SIG"))]"" D EN^PSOSIGNO(ORD,PSONEW("SIG")) S SIG(1)=PSONEW("SIG")
    95         I $G(PSOSIGFL) D
    96         .K DIRUT,DUOUT,DTOUT,DIR S DIR(0)="Y",DIR("B")="NO",DIR("A",1)="",DIR("A")="This edit will create a new order.  Do you want to continue" D ^DIR
    97         .I 'Y!($D(DIRUT)) K DIR,DIRUT,DUOUT,DTOUT,DIC,Y,PSOSIGFL,PSONEW("SIG") S SIGOK=1
    98         S PSONEW("CLERK CODE")=DUZ K DIR,DIRUT,DUOUT,DTOUT,DIC,Y
    99         Q
    100         ;
    101 13      S PSONEW("FLD")=11 D COPIES^PSODIR1(.PSONEW) ; Get # of copies
    102         Q
    103         ;
    104 10      S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info
    105         Q
    106         ;
    107 14      S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ; Get Remarks
    108         Q
    109         ;WVEHR ;begin p208
    110         ;
    111 DRGMSG  ;From PSOORNEW
    112         F SG=1:1:$L($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D
    113         .S:$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10),"",SG)
    114         K SG Q
    115         ;
    116         ;WVEHR ;end p208
    117 DREN    ;
    118         S (PSDC,PSI)=0
    119         F  S PSI=$O(^PSDRUG("ASP",PSODRUG("OI"),PSI)) Q:'PSI  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1) S PSDC=PSDC+1,PSDC(PSDC)=PSI
    120         I PSDC'=1 D  G DRENX
    121         .I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q
    122         .K PSODRUG("NAME"),PSODRUG("IEN")
    123         K PSOY S PSI=PSDC(1),PSOY=^PSDRUG(PSI,0)
    124         I $P($G(^PSDRUG(PSI,"CLOZ1")),"^")="PSOCLO1",'$O(^YSCL(603.01,"C",PSODFN,0)) K PSOY,PSI Q
    125         S PSODRUG("IEN")=+PSI,PSODRUG("VA CLASS")=$P(PSOY,"^",2),PSODRUG("NAME")=$P(PSOY,"^")
    126         S PSODRUG("NDF")=$S($G(^PSDRUG(PSI,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
    127         S PSODRUG("MAXDOSE")=$P(PSOY,"^",4),PSODRUG("DEA")=$P(PSOY,"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSI,"ND")):+$P(^("ND"),"^",6),1:0)
    128         S PSODRUG("SIG")=$P(PSOY,"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSI,$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(+PSI,660.1))
    129         S PSODRUG("DAW")=+$$GET1^DIQ(50,+PSI,81)
    130         G:$G(^PSDRUG(+PSI,660))']"" DRENX
    131         S PSOX1=$G(^PSDRUG(+PSI,660)),PSODRUG("COST")=$P($G(PSOX1),"^",6),PSODRUG("UNIT")=$P($G(PSOX1),"^",8),PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
    132 DRENX   K PSDC,PSI,PSOY,Y,PSOXI,X Q
    133 KV      K DIR,DIRUT,DUOUT,DTOUT Q
     1PSOORNW2 ;ISC-BHAM/SAB - edit orders from oerr ; 12/10/06 9:55pm
     2 ;;7.0;OUTPATIENT PHARMACY;**10,23,37,46,117,131,133,148,222,208**;DEC 1997;Build 39
     3 ; Modified from FOIA VISTA,
     4 ; Copyright (C) 2007 WorldVistA
     5 ;
     6 ; This program is free software; you can redistribute it and/or modify
     7 ; it under the terms of the GNU General Public License as published by
     8 ; the Free Software Foundation; either version 2 of the License, or
     9 ; (at your option) any later version.
     10 ;
     11 ; This program is distributed in the hope that it will be useful,
     12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14 ; GNU General Public License for more details.
     15 ;
     16 ; You should have received a copy of the GNU General Public License
     17 ; along with this program; if not, write to the Free Software
     18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
     19 ;Reference to ^YSCL(603.01 supported by DBIA 2697
     20 ;Reference to ^PS(55 supported by DBIA 2228
     21 ;Reference to ^PSDRUG( supported by DBIA 221
     22 ;Reference to ^PS(50.606 supported by DBIA 2174
     23 ;Reference to ^PS(50.7 supported by DBIA 2223
     24 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
     25 ;
     261 I $G(PSODRUG("OI")) M:$G(PSOBDRG) PSOBDR=PSODRUG W !!,"Current Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
     27 S DIC("B")=$S($G(PSODRUG("OIN"))]"":PSODRUG("OIN"),1:""),DIC="^PS(50.7,",DIC(0)="AEMQZ"
     28 S DIC("S")="I '$P(^PS(50.7,+Y,0),""^"",4)!($P(^(0),""^"",4)'<DT) N PSOF,PSOL S (PSOF,PSOL)=0 F  S PSOL=$O(^PSDRUG(""ASP"",+Y,PSOL)) Q:PSOF!'PSOL  "
     29 S DIC("S")=DIC("S")_"I $P($G(^PSDRUG(PSOL,2)),U,3)[""O"",'$G(^(""I""))!($G(^(""I""))'<DT) S PSOF=1" D ^DIC K DIC I X["^"!($D(DTOUT)) S OUT=1 Q
     30 S PSOY=Y
     31 I +Y'=OI D  I 'Y!($D(DIRUT)) D KV,MP1^PSOOREDX K DIC,Y,PSOY S OUT=1 Q
     32 .D KV S DIR(0)="Y",DIR("B")="NO",DIR("A",1)="",DIR("A")="This edit will create a new order.  Do you want to continue" D ^DIR
     33 G:Y<1 1 S PSODRUG("OI")=+PSOY,PSODRUG("OIN")=$P(PSOY,"^",2),PSONEW("CLERK CODE")=DUZ D KV K DIC,PSOY
     34 N PSOIC S PSOIC=1 D DREN
     35 D 2^PSOORNEW Q
     364 S PSONEW("FLD")=1 D ISSDT^PSODIR2(.PSONEW) ; Issue Date
     37 I PSOID>PSONEW("FILL DATE") S PSONEW("FILL DATE")=PSOID,PSORX("FILL DATE")=PSORX("ISSUE DATE")
     38 Q
     39 ;
     405 S PSONEW("FLD")=2 D FILLDT^PSODIR2(.PSONEW) ; Fill date
     41 Q
     42 ;
     43INS S PSONEW("FLD")=114 D INS^PSODIR(.PSONEW) ; Pat Inst
     44 I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW)
     45 Q
     46 ;
     473 S PSONEW("FLD")=3 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status
     48 I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D  Q
     49 .S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:+$P(OR0,"^",11)),PSOMAX=+$P(^PS(53,RXPT,0),"^",4)
     50 .S PSOMAX=$S($G(PSOCS):5,1:11),PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX)
     51 .S PSONEW("# OF REFILLS")=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
     52 I $G(PSOMAX) S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11))
     53 I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F") D
     54 .S PSONEW("# OF REFILLS")=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["F":"this drug.",1:"Narcotics ...")
     55 Q
     56 ;
     5712 S PSONEW("FLD")=4 D PROV^PSODIR(.PSONEW) ; Get Provider
     58 Q
     59 ;
     6011 S PSONEW("FLD")=5 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic
     61 Q
     62 ;
     638 S PSONEW("FLD")=7 D QTY^PSODIR1(.PSONEW) ; Get quantity
     64 Q
     65 ;
     667 I '$G(PSODRUG("IEN")) W $C(7),!!,"No Dispense Drug!",! K DIR,DUOUT,DIRUT,DTOUT D 2^PSOORNW1
     67 I '$G(PSODRUG("IEN")) W !,$C(7),"No Dispense Drug Selected! A new Orderable Item may need to be selected.",! Q
     68 S PSONEW("FLD")=8 D DAYS^PSODIR1(.PSONEW) ; Get days supply
     69 Q:'$G(PSONEW("PATIENT STATUS"))
     70 K PSDY,PSDY1,PSMAX,PSTMAX S PSDAYS=PSONEW("DAYS SUPPLY"),PSRF=PSONEW("# OF REFILLS"),PTST=$P(^PS(53,PSONEW("PATIENT STATUS"),0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4),PSODEA=PSODRUG("DEA"),CS=0 ;D EDNEW^PSOORNW1
     71 Q
     729 ;
     73 I '$G(PSONEW("PATIENT STATUS")) W !!,"Rx Patient Status required!",! D 3 I '$G(PSONEW("PATIENT STATUS")) S VALMSG="Rx Patient Status required!",VALMBCK="R" Q
     74 I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D  G ASK
     75 .S PSOMAX=$S($G(CLOZPAT)=2:3,$G(CLOZPAT)=1:1,$G(CLOZPAT)=0:0,1:+$P(^PS(53,RXPT,0),"^",4)) K RXPT
     76 .S:'$G(PSONEW("# OF REFILLS")) PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11))
     77 .S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
     78 .I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F") D  Q
     79 ..S (PSOMAX,PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["F":"this drug.",1:"Narcotics ...")
     80 .I $D(PSODRUG("DEA")) F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)=""  I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S PSOMAX=5
     81 I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F") D  Q
     82 .S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["F":"this drug.",1:"Narcotics ...")
     83 S (PSONEW("N# REF"),PSOMAX,PSONEW("# OF REFILLS"))=+$P(OR0,"^",11)
     84ASK S PSONEW("FLD")=9 D REFILL^PSODIR1(.PSONEW) ; Get # of refills
     85 K PSOMAX,PSMAX,PSTMAX S PSDAYS=PSONEW("DAYS SUPPLY"),PSRF=PSONEW("# OF REFILLS"),PTST=$P(^PS(53,PSONEW("PATIENT STATUS"),0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4),PSODEA=$G(PSODRUG("DEA")),CS=0 D EDNEW^PSOORNW1
     86 Q
     87 ;
     886 Q  K DA S PSONEW("FLD")=10 D SIG^PSODIR1(.PSONEW) ; Get sig
     89 I $G(PSONEW("SIG"))]"" D EN^PSOSIGNO(ORD,PSONEW("SIG")) S SIG(1)=PSONEW("SIG")
     90 I $G(PSOSIGFL) D
     91 .K DIRUT,DUOUT,DTOUT,DIR S DIR(0)="Y",DIR("B")="NO",DIR("A",1)="",DIR("A")="This edit will create a new order.  Do you want to continue" D ^DIR
     92 .I 'Y!($D(DIRUT)) K DIR,DIRUT,DUOUT,DTOUT,DIC,Y,PSOSIGFL,PSONEW("SIG") S SIGOK=1
     93 S PSONEW("CLERK CODE")=DUZ K DIR,DIRUT,DUOUT,DTOUT,DIC,Y
     94 Q
     95 ;
     9613 S PSONEW("FLD")=11 D COPIES^PSODIR1(.PSONEW) ; Get # of copies
     97 Q
     98 ;
     9910 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info
     100 Q
     101 ;
     10214 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ; Get Remarks
     103 Q
     104 ;
     105DRGMSG ;From PSOORNEW
     106 F SG=1:1:$L($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D
     107 .S:$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)
     108 K SG Q
     109 ;
     110DREN ;
     111 S (PSDC,PSI)=0
     112 F  S PSI=$O(^PSDRUG("ASP",PSODRUG("OI"),PSI)) Q:'PSI  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1) S PSDC=PSDC+1,PSDC(PSDC)=PSI
     113 I PSDC'=1 D  G DRENX
     114 .I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q
     115 .K PSODRUG("NAME"),PSODRUG("IEN")
     116 K PSOY S PSI=PSDC(1),PSOY=^PSDRUG(PSI,0)
     117 I $P($G(^PSDRUG(PSI,"CLOZ1")),"^")="PSOCLO1",'$O(^YSCL(603.01,"C",PSODFN,0)) K PSOY,PSI Q
     118 S PSODRUG("IEN")=+PSI,PSODRUG("VA CLASS")=$P(PSOY,"^",2),PSODRUG("NAME")=$P(PSOY,"^")
     119 S PSODRUG("NDF")=$S($G(^PSDRUG(PSI,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
     120 S PSODRUG("MAXDOSE")=$P(PSOY,"^",4),PSODRUG("DEA")=$P(PSOY,"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSI,"ND")):+$P(^("ND"),"^",6),1:0)
     121 S PSODRUG("SIG")=$P(PSOY,"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSI,$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(+PSI,660.1))
     122 S PSODRUG("DAW")=+$$GET1^DIQ(50,+PSI,81)
     123 G:$G(^PSDRUG(+PSI,660))']"" DRENX
     124 S PSOX1=$G(^PSDRUG(+PSI,660)),PSODRUG("COST")=$P($G(PSOX1),"^",6),PSODRUG("UNIT")=$P($G(PSOX1),"^",8),PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
     125DRENX K PSDC,PSI,PSOY,Y,PSOXI,X Q
     126KV K DIR,DIRUT,DUOUT,DTOUT Q
Note: See TracChangeset for help on using the changeset viewer.