- 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
