PSOORNW2 ;ISC-BHAM/SAB - edit orders from oerr ;29-May-2012 15:00;PLS
;;7.0;OUTPATIENT PHARMACY;**10,23,37,46,117,131,133,1005,1008,148,222,269,206,1015**;DEC 1997;Build 62
;Reference to ^YSCL(603.01 supported by DBIA 2697
;Reference to ^PS(55 supported by DBIA 2228
;Reference to ^PSDRUG( supported by DBIA 221
;Reference to ^PS(50.606 supported by DBIA 2174
;Reference to ^PS(50.7 supported by DBIA 2223
;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
; Modified - IHS/CIA/PLS - 01/26/04 - Lines DREN+12
; IHS/MSC/PLS - 03/23/09 - Line 3+3
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),"^")
S DIC("B")=$S($G(PSODRUG("OIN"))]"":PSODRUG("OIN"),1:""),DIC="^PS(50.7,",DIC(0)="AEMQZ"
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 "
S DIC("S")=DIC("S")_"I $P($G(^PSDRUG(PSOL,2)),U,3)[""O"",'$G(^(""I""))!($G(^(""I""))'<DT) S PSOF=1"
;BHW;PSO*7*269;Modify ^DIC call to call MIX^DIC to use only the B and C Cross-References.
S D="B^C" D MIX^DIC1 K DIC,D I X["^"!($D(DTOUT)) S OUT=1 Q
S PSOY=Y
I +Y'=OI D I 'Y!($D(DIRUT)) D KV,MP1^PSOOREDX K DIC,Y,PSOY S OUT=1 Q
.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
G:Y<1 1 S PSODRUG("OI")=+PSOY,PSODRUG("OIN")=$P(PSOY,"^",2),PSONEW("CLERK CODE")=DUZ D KV K DIC,PSOY
N PSOIC S PSOIC=1 D DREN
D 2^PSOORNEW Q
4 S PSONEW("FLD")=1 D ISSDT^PSODIR2(.PSONEW) ; Issue Date
I PSOID>PSONEW("FILL DATE") S PSONEW("FILL DATE")=PSOID,PSORX("FILL DATE")=PSORX("ISSUE DATE")
Q
;
5 S PSONEW("FLD")=2 D FILLDT^PSODIR2(.PSONEW) ; Fill date
Q
;
INS S PSONEW("FLD")=114 D INS^PSODIR(.PSONEW) ; Pat Inst
I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW)
Q
;
3 S PSONEW("FLD")=3 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status
I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D Q
.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)
.;IHS/MSC/PLS - 03/23/09 - Changed default refill from 11 to 15
.;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)
.S PSOMAX=$S($G(PSOCS):5,1:15),PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX)
.S PSONEW("# OF REFILLS")=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
I $G(PSOMAX) S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11))
I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F")!($G(PSODRUG("DEA"))[1)!($G(PSODRUG("DEA"))[2) D
.S PSONEW("# OF REFILLS")=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
Q
;
12 S PSONEW("FLD")=4 D PROV^PSODIR(.PSONEW) ; Get Provider
Q
;
11 S PSONEW("FLD")=5 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic
Q
;
8 S PSONEW("FLD")=7 D QTY^PSODIR1(.PSONEW) ; Get quantity
Q
;
7 I '$G(PSODRUG("IEN")) W $C(7),!!,"No Dispense Drug!",! K DIR,DUOUT,DIRUT,DTOUT D 2^PSOORNW1
I '$G(PSODRUG("IEN")) W !,$C(7),"No Dispense Drug Selected! A new Orderable Item may need to be selected.",! Q
S PSONEW("FLD")=8 D DAYS^PSODIR1(.PSONEW) ; Get days supply
Q:'$G(PSONEW("PATIENT STATUS"))
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
Q
9 ;
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
I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D G ASK
.S PSOMAX=$S($G(CLOZPAT)=2:3,$G(CLOZPAT)=1:1,$G(CLOZPAT)=0:0,1:+$P(^PS(53,RXPT,0),"^",4)) K RXPT
.S:'$G(PSONEW("# OF REFILLS")) PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11))
.S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
.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
..S (PSOMAX,PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
.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
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
.S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0,VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
S (PSONEW("N# REF"),PSOMAX,PSONEW("# OF REFILLS"))=+$P(OR0,"^",11)
ASK S PSONEW("FLD")=9 D REFILL^PSODIR1(.PSONEW) ; Get # of refills
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
Q
;
6 Q K DA S PSONEW("FLD")=10 D SIG^PSODIR1(.PSONEW) ; Get sig
I $G(PSONEW("SIG"))]"" D EN^PSOSIGNO(ORD,PSONEW("SIG")) S SIG(1)=PSONEW("SIG")
I $G(PSOSIGFL) D
.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
.I 'Y!($D(DIRUT)) K DIR,DIRUT,DUOUT,DTOUT,DIC,Y,PSOSIGFL,PSONEW("SIG") S SIGOK=1
S PSONEW("CLERK CODE")=DUZ K DIR,DIRUT,DUOUT,DTOUT,DIC,Y
Q
;
13 S PSONEW("FLD")=11 D COPIES^PSODIR1(.PSONEW) ; Get # of copies
Q
;
10 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info
Q
;
14 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ; Get Remarks
Q
DREN ;
S (PSDC,PSI)=0
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
I PSDC'=1 D G DRENX
.I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q
.K PSODRUG("NAME"),PSODRUG("IEN")
K PSOY S PSI=PSDC(1),PSOY=^PSDRUG(PSI,0)
I $P($G(^PSDRUG(PSI,"CLOZ1")),"^")="PSOCLO1",'$O(^YSCL(603.01,"C",PSODFN,0)) K PSOY,PSI Q
S PSODRUG("IEN")=+PSI,PSODRUG("VA CLASS")=$P(PSOY,"^",2),PSODRUG("NAME")=$P(PSOY,"^")
S PSODRUG("NDF")=$S($G(^PSDRUG(PSI,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
S PSODRUG("MAXDOSE")=$P(PSOY,"^",4),PSODRUG("DEA")=$P(PSOY,"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSI,"ND")):+$P(^("ND"),"^",6),1:0)
S PSODRUG("SIG")=$P(PSOY,"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSI,$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(+PSI,660.1))
; IHS/CIA/PLS - 01/25/04 - Calculate NDC, AWP and COST
S PSODRUG("DAW")=+$$GET1^DIQ(50,+PSI,81)
S PSONEW("NDC")=$G(PSODRUG("NDC"))
S:('$D(PSONEW("AWP")))&('$G(PSONEW("DFLG")))&('$G(PSONEW("QFLG"))) PSONEW("AWP")=$$AWP^APSQDAWP($S($D(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
S:('$D(PSONEW("COST")))&('$G(PSONEW("DFLG")))&('$G(PSONEW("QFLG"))) PSONEW("COST")=$$COST^APSQDAWP($S($D(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
G:$G(^PSDRUG(+PSI,660))']"" DRENX
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)
DRENX K PSDC,PSI,PSOY,Y,PSOXI,X Q
KV K DIR,DIRUT,DUOUT,DTOUT Q
PSOORNW2 ;ISC-BHAM/SAB - edit orders from oerr ;29-May-2012 15:00;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**10,23,37,46,117,131,133,1005,1008,148,222,269,206,1015**;DEC 1997;Build 62
+2 ;Reference to ^YSCL(603.01 supported by DBIA 2697
+3 ;Reference to ^PS(55 supported by DBIA 2228
+4 ;Reference to ^PSDRUG( supported by DBIA 221
+5 ;Reference to ^PS(50.606 supported by DBIA 2174
+6 ;Reference to ^PS(50.7 supported by DBIA 2223
+7 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
+8 ; Modified - IHS/CIA/PLS - 01/26/04 - Lines DREN+12
+9 ; IHS/MSC/PLS - 03/23/09 - Line 3+3
1 IF $GET(PSODRUG("OI"))
IF $GET(PSOBDRG)
MERGE PSOBDR=PSODRUG
WRITE !!,"Current Orderable Item: "_$PIECE(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+1 SET DIC("B")=$SELECT($GET(PSODRUG("OIN"))]"":PSODRUG("OIN"),1:"")
SET DIC="^PS(50.7,"
SET DIC(0)="AEMQZ"
+2 SET 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 "
+3 SET DIC("S")=DIC("S")_"I $P($G(^PSDRUG(PSOL,2)),U,3)[""O"",'$G(^(""I""))!($G(^(""I""))'<DT) S PSOF=1"
+4 ;BHW;PSO*7*269;Modify ^DIC call to call MIX^DIC to use only the B and C Cross-References.
+5 SET D="B^C"
DO MIX^DIC1
KILL DIC,D
IF X["^"!($DATA(DTOUT))
SET OUT=1
QUIT
+6 SET PSOY=Y
+7 IF +Y'=OI
Begin DoDot:1
+8 DO KV
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A",1)=""
SET DIR("A")="This edit will create a new order. Do you want to continue"
DO ^DIR
End DoDot:1
IF 'Y!($DATA(DIRUT))
DO KV
DO MP1^PSOOREDX
KILL DIC,Y,PSOY
SET OUT=1
QUIT
+9 IF Y<1
GOTO 1
SET PSODRUG("OI")=+PSOY
SET PSODRUG("OIN")=$PIECE(PSOY,"^",2)
SET PSONEW("CLERK CODE")=DUZ
DO KV
KILL DIC,PSOY
+10 NEW PSOIC
SET PSOIC=1
DO DREN
+11 DO 2^PSOORNEW
QUIT
4 ; Issue Date
SET PSONEW("FLD")=1
DO ISSDT^PSODIR2(.PSONEW)
+1 IF PSOID>PSONEW("FILL DATE")
SET PSONEW("FILL DATE")=PSOID
SET PSORX("FILL DATE")=PSORX("ISSUE DATE")
+2 QUIT
+3 ;
5 ; Fill date
SET PSONEW("FLD")=2
DO FILLDT^PSODIR2(.PSONEW)
+1 QUIT
+2 ;
INS ; Pat Inst
SET PSONEW("FLD")=114
DO INS^PSODIR(.PSONEW)
+1 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
DO SINS^PSODIR(.PSONEW)
+2 QUIT
+3 ;
3 ; Get Patient Status
SET PSONEW("FLD")=3
DO PTSTAT^PSODIR1(.PSONEW)
+1 IF +$GET(^PS(55,PSODFN,"PS"))
SET RXPT=+^("PS")
IF $GET(^PS(53,RXPT,0))]""
Begin DoDot:1
+2 SET PSONEW("# OF REFILLS")=$SELECT(+$PIECE(OR0,"^",11)>+$PIECE(^PS(53,RXPT,0),"^",4):+$PIECE(^PS(53,RXPT,0),"^",4),1:+$PIECE(OR0,"^",11))
SET PSOMAX=+$PIECE(^PS(53,RXPT,0),"^",4)
+3 ;IHS/MSC/PLS - 03/23/09 - Changed default refill from 11 to 15
+4 ;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)
+5 SET PSOMAX=$SELECT($GET(PSOCS):5,1:15)
SET PSOMAX=$SELECT(PSOMAX>+$PIECE(^PS(53,RXPT,0),"^",4):+$PIECE(^PS(53,RXPT,0),"^",4),1:PSOMAX)
+6 SET PSONEW("# OF REFILLS")=$SELECT(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
End DoDot:1
QUIT
+7 IF $GET(PSOMAX)
SET PSONEW("# OF REFILLS")=$SELECT(+$PIECE(OR0,"^",11)>PSOMAX:PSOMAX,1:+$PIECE(OR0,"^",11))
+8 IF $GET(PSODRUG("DEA"))["A"&($GET(PSODRUG("DEA"))'["B")!($GET(PSODRUG("DEA"))["F")!($GET(PSODRUG("DEA"))[1)!($GET(PSODRUG("DEA"))[2)
Begin DoDot:1
+9 SET PSONEW("# OF REFILLS")=0
SET VALMSG="No refills allowed on "_$SELECT(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
End DoDot:1
+10 QUIT
+11 ;
12 ; Get Provider
SET PSONEW("FLD")=4
DO PROV^PSODIR(.PSONEW)
+1 QUIT
+2 ;
11 ; Get Clinic
SET PSONEW("FLD")=5
DO CLINIC^PSODIR2(.PSONEW)
+1 QUIT
+2 ;
8 ; Get quantity
SET PSONEW("FLD")=7
DO QTY^PSODIR1(.PSONEW)
+1 QUIT
+2 ;
7 IF '$GET(PSODRUG("IEN"))
WRITE $CHAR(7),!!,"No Dispense Drug!",!
KILL DIR,DUOUT,DIRUT,DTOUT
DO 2^PSOORNW1
+1 IF '$GET(PSODRUG("IEN"))
WRITE !,$CHAR(7),"No Dispense Drug Selected! A new Orderable Item may need to be selected.",!
QUIT
+2 ; Get days supply
SET PSONEW("FLD")=8
DO DAYS^PSODIR1(.PSONEW)
+3 IF '$GET(PSONEW("PATIENT STATUS"))
QUIT
+4 ;D EDNEW^PSOORNW1
KILL PSDY,PSDY1,PSMAX,PSTMAX
SET PSDAYS=PSONEW("DAYS SUPPLY")
SET PSRF=PSONEW("# OF REFILLS")
SET PTST=$PIECE(^PS(53,PSONEW("PATIENT STATUS"),0),"^")
SET PTDY=$PIECE(^(0),"^",3)
SET PTRF=$PIECE(^(0),"^",4)
SET PSODEA=PSODRUG("DEA")
SET CS=0
+5 QUIT
9 ;
+1 IF '$GET(PSONEW("PATIENT STATUS"))
WRITE !!,"Rx Patient Status required!",!
DO 3
IF '$GET(PSONEW("PATIENT STATUS"))
SET VALMSG="Rx Patient Status required!"
SET VALMBCK="R"
QUIT
+2 IF +$GET(^PS(55,PSODFN,"PS"))
SET RXPT=+^("PS")
IF $GET(^PS(53,RXPT,0))]""
Begin DoDot:1
+3 SET PSOMAX=$SELECT($GET(CLOZPAT)=2:3,$GET(CLOZPAT)=1:1,$GET(CLOZPAT)=0:0,1:+$PIECE(^PS(53,RXPT,0),"^",4))
KILL RXPT
+4 IF '$GET(PSONEW("# OF REFILLS"))
SET PSONEW("# OF REFILLS")=$SELECT(+$PIECE(OR0,"^",11)>PSOMAX:PSOMAX,1:+$PIECE(OR0,"^",11))
+5 SET (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=$SELECT(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
+6 IF '$DATA(CLOZPAT)
IF $GET(PSODRUG("DEA"))["A"&($GET(PSODRUG("DEA"))'["B")!($GET(PSODRUG("DEA"))["F")!($GET(PSODRUG("DEA"))[1)!($GET(PSODRUG("DEA"))[2)
Begin DoDot:2
+7 SET (PSOMAX,PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0
SET VALMSG="No refills allowed on "_$SELECT(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
End DoDot:2
QUIT
+8 IF $DATA(PSODRUG("DEA"))
FOR DEA=1:1
IF $EXTRACT(PSODRUG("DEA"),DEA)=""
QUIT
IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
SET PSOMAX=5
End DoDot:1
GOTO ASK
+9 IF '$DATA(CLOZPAT)
IF $GET(PSODRUG("DEA"))["A"&($GET(PSODRUG("DEA"))'["B")!($GET(PSODRUG("DEA"))["F")!($GET(PSODRUG("DEA"))[1)!($GET(PSODRUG("DEA"))[2)
Begin DoDot:1
+10 SET (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=0
SET VALMSG="No refills allowed on "_$SELECT(PSODRUG("DEA")["A":"this narcotic drug.",1:"this drug.")
End DoDot:1
QUIT
+11 SET (PSONEW("N# REF"),PSOMAX,PSONEW("# OF REFILLS"))=+$PIECE(OR0,"^",11)
ASK ; Get # of refills
SET PSONEW("FLD")=9
DO REFILL^PSODIR1(.PSONEW)
+1 KILL PSOMAX,PSMAX,PSTMAX
SET PSDAYS=PSONEW("DAYS SUPPLY")
SET PSRF=PSONEW("# OF REFILLS")
SET PTST=$PIECE(^PS(53,PSONEW("PATIENT STATUS"),0),"^")
SET PTDY=$PIECE(^(0),"^",3)
SET PTRF=$PIECE(^(0),"^",4)
SET PSODEA=$GET(PSODRUG("DEA"))
SET CS=0
DO EDNEW^PSOORNW1
+2 QUIT
+3 ;
6 ; Get sig
QUIT
KILL DA
SET PSONEW("FLD")=10
DO SIG^PSODIR1(.PSONEW)
+1 IF $GET(PSONEW("SIG"))]""
DO EN^PSOSIGNO(ORD,PSONEW("SIG"))
SET SIG(1)=PSONEW("SIG")
+2 IF $GET(PSOSIGFL)
Begin DoDot:1
+3 KILL DIRUT,DUOUT,DTOUT,DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A",1)=""
SET DIR("A")="This edit will create a new order. Do you want to continue"
DO ^DIR
+4 IF 'Y!($DATA(DIRUT))
KILL DIR,DIRUT,DUOUT,DTOUT,DIC,Y,PSOSIGFL,PSONEW("SIG")
SET SIGOK=1
End DoDot:1
+5 SET PSONEW("CLERK CODE")=DUZ
KILL DIR,DIRUT,DUOUT,DTOUT,DIC,Y
+6 QUIT
+7 ;
13 ; Get # of copies
SET PSONEW("FLD")=11
DO COPIES^PSODIR1(.PSONEW)
+1 QUIT
+2 ;
10 ; Get Mail/Window Info
SET PSONEW("FLD")=12
DO MW^PSODIR2(.PSONEW)
+1 QUIT
+2 ;
14 ; Get Remarks
SET PSONEW("FLD")=13
DO RMK^PSODIR2(.PSONEW)
+1 QUIT
DREN ;
+1 SET (PSDC,PSI)=0
+2 FOR
SET PSI=$ORDER(^PSDRUG("ASP",PSODRUG("OI"),PSI))
IF 'PSI
QUIT
IF $SELECT('$DATA(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0)
IF $SELECT($PIECE($GET(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1)
SET PSDC=PSDC+1
SET PSDC(PSDC)=PSI
+3 IF PSDC'=1
Begin DoDot:1
+4 IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),2)),"^")=$GET(PSODRUG("OI"))
QUIT
+5 KILL PSODRUG("NAME"),PSODRUG("IEN")
End DoDot:1
GOTO DRENX
+6 KILL PSOY
SET PSI=PSDC(1)
SET PSOY=^PSDRUG(PSI,0)
+7 IF $PIECE($GET(^PSDRUG(PSI,"CLOZ1")),"^")="PSOCLO1"
IF '$ORDER(^YSCL(603.01,"C",PSODFN,0))
KILL PSOY,PSI
QUIT
+8 SET PSODRUG("IEN")=+PSI
SET PSODRUG("VA CLASS")=$PIECE(PSOY,"^",2)
SET PSODRUG("NAME")=$PIECE(PSOY,"^")
+9 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(PSI,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
+10 SET PSODRUG("MAXDOSE")=$PIECE(PSOY,"^",4)
SET PSODRUG("DEA")=$PIECE(PSOY,"^",3)
SET PSODRUG("CLN")=$SELECT($DATA(^PSDRUG(+PSI,"ND")):+$PIECE(^("ND"),"^",6),1:0)
+11 SET PSODRUG("SIG")=$PIECE(PSOY,"^",5)
SET PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSI,$GET(PSOSITE))
SET PSODRUG("STKLVL")=$GET(^PSDRUG(+PSI,660.1))
+12 ; IHS/CIA/PLS - 01/25/04 - Calculate NDC, AWP and COST
+13 SET PSODRUG("DAW")=+$$GET1^DIQ(50,+PSI,81)
+14 SET PSONEW("NDC")=$GET(PSODRUG("NDC"))
+15 IF ('$DATA(PSONEW("AWP")))&('$GET(PSONEW("DFLG")))&('$GET(PSONEW("QFLG")))
SET PSONEW("AWP")=$$AWP^APSQDAWP($SELECT($DATA(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
+16 IF ('$DATA(PSONEW("COST")))&('$GET(PSONEW("DFLG")))&('$GET(PSONEW("QFLG")))
SET PSONEW("COST")=$$COST^APSQDAWP($SELECT($DATA(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
+17 IF $GET(^PSDRUG(+PSI,660))']""
GOTO DRENX
+18 SET PSOX1=$GET(^PSDRUG(+PSI,660))
SET PSODRUG("COST")=$PIECE($GET(PSOX1),"^",6)
SET PSODRUG("UNIT")=$PIECE($GET(PSOX1),"^",8)
SET PSODRUG("EXPIRATION DATE")=$PIECE($GET(PSOX1),"^",9)
DRENX KILL PSDC,PSI,PSOY,Y,PSOXI,X
QUIT
KV KILL DIR,DIRUT,DUOUT,DTOUT
QUIT
