PSOORNW1 ;ISC BHAM/SAB - continuation of finish of new order ;Jun 25, 2018@13:38
;;7.0;OUTPATIENT PHARMACY;**23,46,78,117,131,133,172,148,222,268,206,251,379,391,313,444,469,422,477,651,747**;DEC 1997;Build 7
; Reference to ^YSCL(603.01 in ICR #2697
; Reference to ^PS(55 in ICR #2228
; Reference to ^PSDRUG( in ICR #221
; Reference to $$GETNDC^PSSNDCUT in ICR #4707
;
2 I $G(ORD),$G(ORSV) W !!,$S($$ERXIEN^PSOERXUT(ORD_"P"):"eRx ",1:""),"Instructions: " D
.S INST=0 F S INST=$O(^PS(52.41,ORD,2,INST)) Q:'INST S (MIG,INST(INST))=^PS(52.41,ORD,2,INST,0) D
..F SG=1:1:$L(MIG," ") W:$X+$L($P(MIG," ",SG)_" ")>IOM !?14 W $P(MIG," ",SG)_" "
.S:'$D(PSODRUG("OI")) PSODRUG("OI")=$P(OR0,"^",8)
.K INST,TY,MIG,SG
N DEFAULT
S (PSDC,PSI,DEFAULT)=0 W !!,"The following Drug(s) are available for selection:"
F PSI=0:0 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) D
.S PSDC=PSDC+1 W !,PSDC_". "_$P(^PSDRUG(PSI,0),"^")_$S($P(^(0),"^",9):" (N/F)",1:"")
.S PSDC(PSDC)=PSI I $G(PSORXED("DRUG IEN")),PSI=$G(PSORXED("DRUG IEN")) S DEFAULT=PSDC
I PSDC=0 D
. N X,DRG
. S DRG=+$P($G(^PS(52.41,+$G(ORD),0)),"^",9)
. S X=$$GET1^DIQ(50,DRG,100)
. I X'="",(DT>X) D
. . W !!," This Dispense Drug is now Inactive. You may select a"
. . W !," new Orderable Item, or you can enter a new Order with"
. . W !," an Active Drug.",!
. E W !!,"No drugs available!",!
. K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press return to continue"
. D ^DIR K DIR
G:'PSDC ETX I $G(PSOBDRG),'$D(PSOBDR) M PSOBDR=PSODRUG
I PSDC'=1 D
.I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q
.K PSODRUG("NAME"),PSODRUG("IEN")
W ! D KV
S DIR(0)="N^1:"_PSDC S:$G(DEFAULT) DIR("B")=DEFAULT
S DIR("A")="Select Drug by number" D ^DIR
I $D(DIRUT) S OUT=1 G EX
D KV K PSOY S PSOY=PSDC(Y),PSOY(0)=^PSDRUG(PSOY,0),PSOCSIG=0
I $G(PSOBDR("IEN")),PSOBDR("IEN")'=+PSOY D:$G(ORD) ;G:$D(DIRUT) EX ;*422
.N PSOMSG S PSOMSG(1)="You have changed the dispense drug from",PSOMSG(2)=$G(PSOBDR("NAME"))_" to "_$P(^PSDRUG(+PSOY,0),"^")_"." D EN^DDIOL(.PSOMSG,"","!") S (PSOAC,PSOCSIG)=1 ;*422
.K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press return to continue" ;*422
.D ^DIR K DIR ;*422
CT1 I $P($G(^PSDRUG(PSOY,"CLOZ1")),"^")="PSOCLO1",'$O(^YSCL(603.01,"C",PSODFN,0)) D Q
.S VALMSG="Patient Not Registered in Clozapine Program",VALMBCK="Q" K PSOY,PSDC
I $G(ORD) S ^TMP("PSORXPO",$J,ORD,0)=1
S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2),PSODRUG("NAME")=$P(PSOY(0),"^")
S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
S PSODRUG("MAXDOSE")=$P(PSOY(0),"^",4),PSODRUG("DEA")=$P(PSOY(0),"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSOY,"ND")):+$P(^("ND"),"^",6),1:0)
S PSODRUG("SIG")=$P(PSOY(0),"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(+PSOY,660.1))
S PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
I PSODRUG("DAW")="" S PSODRUG("DAW")=0
S PSOX1=$G(^PSDRUG(+PSOY,660)),PSODRUG("COST")=$P($G(PSOX1),"^",6),PSODRUG("UNIT")=$P($G(PSOX1),"^",8),PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
D:('$G(PSOFIN)&('$G(PSOCOPY)))!($G(PSOAC)) POST^PSODRG I $G(PSORX("DFLG")) K PSODRUG N LST Q:$G(PSOAC)!($G(NEWEDT)) D DSPL^PSOORFI1 S VALMBCK="Q" Q
;
; If current DAYS SUPPLY on the order > Maximum allowed for Dispense Drug prompt user for DAYS SUPPLY
I $$MXDAYSUP^PSSUTIL1(PSOY)<$G(PSONEW("DAYS SUPPLY")) D DAYS^PSODIR1(.PSONEW)
I $G(PSONEW("DFLG")) K PSODRUG S OUT=1 G EX
;
ETX D REF S VALMBCK="R" I 'PSDC S VALMSG="NO dispense drugs tied to this orderable item!" S PSOQFLG=1
TX D KV K PSDC,PSI,X,Y,PSOX1,PSOY
Q
EX M PSODRUG=PSOBDR K PSOBDR,PSOBDRG S PSOQFLG=1,VALMBCK="R" D MP1^PSOOREDX
D TX Q
URX D KV S DIR(0)="Y",DIR("A")="Are You Sure You Want to Update Rx",DIR("B")="Yes"
D ^DIR S:$D(DIRUT)!('Y) DIRUT=1
I Y S ^TMP("PSORXPO",$J,ORD,0)=1 ;screens 4 order checks
Q
REF ;
; Retrieving the Maximum Number of Refills allowed
N MAXRF S MAXRF=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSONEW("DAYS SUPPLY")),+$G(PSONEW("PATIENT STATUS")),.CLOZPAT)
I ($G(PSONEW("# OF REFILLS"))'="")&($G(PSONEW("# OF REFILLS"))'>MAXRF) D
. S PSONEW("N# REF")=PSONEW("# OF REFILLS")
E D
. S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=MAXRF
Q
;
EDNEW ;
N MAXRF S MAXRF=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSONEW("DAYS SUPPLY")),+$G(PSONEW("PATIENT STATUS")),.CLOZPAT)
I PSRF>MAXRF D
.W $C(7),!!,PSRF_" refills are not correct for a "_PSDAYS_" day supply.",!,"Please enter correct # of refills for a "_PSDAYS_" day supply. Max refills allowed is "_MAXRF_".",!
.S (PSMAX("MAX"),PSFMAX("MAX"))=MAXRF,(PSMAX("RF"),PSFMAX("RF"))=PSRF,(PSMAX("DAYS"),PSFMAX("DAYS"))=PSDAYS,(PSMAX,PSFMAX)=1
K PSTMAX D EDSTAT
Q
STATDAY K PSMAX,PSRMAX,PSFMAX,PSTMAX S PSDAYS=$P(^PSRX(DA,0),"^",8),PSRF=$P(^PSRX(DA,0),"^",9),PTST=$P(^PS(53,X,0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4)
EDSTAT I PSRF>PTRF W !,$C(7),PSRF_" refills are greater than "_PTRF_" allowed for "_$P(PTST,"^")_" Rx Patient Status.",! S PSTMAX=1,PSTMAX("PTRF")=PTRF,PSTMAX("PSRF")=PSRF,PSTMAX("PT")=$P(PTST,"^")
Q
OERF S DIR(0)="N^0:"_PSOX,DIR("A")="# OF REFILLS"
S DIR("B")=$S($G(POERR):PSONEW("# OF REFILLS"),$G(PSONEW("N# REF"))]"":PSONEW("N# REF"),$G(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),$G(PSOX1)]""&(PSOX>PSOX1):PSOX1,1:PSOX)
S DIR("?")="Enter a whole number. The maximum is set by the Rx Patient Status because there is no Dispense Drug."
D ^DIR G:$D(DIRUT) REFX
S (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=Y
REFX S:'$D(PSONEW("# OF REFILLS")) PSONEW("# OF REFILLS")=$S($G(PSONEW("N# REF"))]"":PSONEW("N# REF"),$G(PSOX1)]""&($G(PSOX)>PSOX1):PSOX1,1:PSOX)
K X,Y,PSOX,PSOX1,PSDY,PSDY1,DEA
KV K DIR,DIRUT,DUOUT,DTOUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORNW1 5923 printed Dec 13, 2024@02:32:14 Page 2
PSOORNW1 ;ISC BHAM/SAB - continuation of finish of new order ;Jun 25, 2018@13:38
+1 ;;7.0;OUTPATIENT PHARMACY;**23,46,78,117,131,133,172,148,222,268,206,251,379,391,313,444,469,422,477,651,747**;DEC 1997;Build 7
+2 ; Reference to ^YSCL(603.01 in ICR #2697
+3 ; Reference to ^PS(55 in ICR #2228
+4 ; Reference to ^PSDRUG( in ICR #221
+5 ; Reference to $$GETNDC^PSSNDCUT in ICR #4707
+6 ;
2 IF $GET(ORD)
IF $GET(ORSV)
WRITE !!,$SELECT($$ERXIEN^PSOERXUT(ORD_"P"):"eRx ",1:""),"Instructions: "
Begin DoDot:1
+1 SET INST=0
FOR
SET INST=$ORDER(^PS(52.41,ORD,2,INST))
if 'INST
QUIT
SET (MIG,INST(INST))=^PS(52.41,ORD,2,INST,0)
Begin DoDot:2
+2 FOR SG=1:1:$LENGTH(MIG," ")
if $X+$LENGTH($PIECE(MIG," ",SG)_" ")>IOM
WRITE !?14
WRITE $PIECE(MIG," ",SG)_" "
End DoDot:2
+3 if '$DATA(PSODRUG("OI"))
SET PSODRUG("OI")=$PIECE(OR0,"^",8)
+4 KILL INST,TY,MIG,SG
End DoDot:1
+5 NEW DEFAULT
+6 SET (PSDC,PSI,DEFAULT)=0
WRITE !!,"The following Drug(s) are available for selection:"
+7 FOR PSI=0:0
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)
Begin DoDot:1
+8 SET PSDC=PSDC+1
WRITE !,PSDC_". "_$PIECE(^PSDRUG(PSI,0),"^")_$SELECT($PIECE(^(0),"^",9):" (N/F)",1:"")
+9 SET PSDC(PSDC)=PSI
IF $GET(PSORXED("DRUG IEN"))
IF PSI=$GET(PSORXED("DRUG IEN"))
SET DEFAULT=PSDC
End DoDot:1
+10 IF PSDC=0
Begin DoDot:1
+11 NEW X,DRG
+12 SET DRG=+$PIECE($GET(^PS(52.41,+$GET(ORD),0)),"^",9)
+13 SET X=$$GET1^DIQ(50,DRG,100)
+14 IF X'=""
IF (DT>X)
Begin DoDot:2
+15 WRITE !!," This Dispense Drug is now Inactive. You may select a"
+16 WRITE !," new Orderable Item, or you can enter a new Order with"
+17 WRITE !," an Active Drug.",!
End DoDot:2
+18 IF '$TEST
WRITE !!,"No drugs available!",!
+19 KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press return to continue"
+20 DO ^DIR
KILL DIR
End DoDot:1
+21 if 'PSDC
GOTO ETX
IF $GET(PSOBDRG)
IF '$DATA(PSOBDR)
MERGE PSOBDR=PSODRUG
+22 IF PSDC'=1
Begin DoDot:1
+23 IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),2)),"^")=$GET(PSODRUG("OI"))
QUIT
+24 KILL PSODRUG("NAME"),PSODRUG("IEN")
End DoDot:1
+25 WRITE !
DO KV
+26 SET DIR(0)="N^1:"_PSDC
if $GET(DEFAULT)
SET DIR("B")=DEFAULT
+27 SET DIR("A")="Select Drug by number"
DO ^DIR
+28 IF $DATA(DIRUT)
SET OUT=1
GOTO EX
+29 DO KV
KILL PSOY
SET PSOY=PSDC(Y)
SET PSOY(0)=^PSDRUG(PSOY,0)
SET PSOCSIG=0
+30 ;G:$D(DIRUT) EX ;*422
IF $GET(PSOBDR("IEN"))
IF PSOBDR("IEN")'=+PSOY
if $GET(ORD)
Begin DoDot:1
+31 ;*422
NEW PSOMSG
SET PSOMSG(1)="You have changed the dispense drug from"
SET PSOMSG(2)=$GET(PSOBDR("NAME"))_" to "_$PIECE(^PSDRUG(+PSOY,0),"^")_"."
DO EN^DDIOL(.PSOMSG,"","!")
SET (PSOAC,PSOCSIG)=1
+32 ;*422
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press return to continue"
+33 ;*422
DO ^DIR
KILL DIR
End DoDot:1
CT1 IF $PIECE($GET(^PSDRUG(PSOY,"CLOZ1")),"^")="PSOCLO1"
IF '$ORDER(^YSCL(603.01,"C",PSODFN,0))
Begin DoDot:1
+1 SET VALMSG="Patient Not Registered in Clozapine Program"
SET VALMBCK="Q"
KILL PSOY,PSDC
End DoDot:1
QUIT
+2 IF $GET(ORD)
SET ^TMP("PSORXPO",$JOB,ORD,0)=1
+3 SET PSODRUG("IEN")=+PSOY
SET PSODRUG("VA CLASS")=$PIECE(PSOY(0),"^",2)
SET PSODRUG("NAME")=$PIECE(PSOY(0),"^")
+4 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
+5 SET PSODRUG("MAXDOSE")=$PIECE(PSOY(0),"^",4)
SET PSODRUG("DEA")=$PIECE(PSOY(0),"^",3)
SET PSODRUG("CLN")=$SELECT($DATA(^PSDRUG(+PSOY,"ND")):+$PIECE(^("ND"),"^",6),1:0)
+6 SET PSODRUG("SIG")=$PIECE(PSOY(0),"^",5)
SET PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$GET(PSOSITE))
SET PSODRUG("STKLVL")=$GET(^PSDRUG(+PSOY,660.1))
+7 SET PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
+8 IF PSODRUG("DAW")=""
SET PSODRUG("DAW")=0
+9 SET PSOX1=$GET(^PSDRUG(+PSOY,660))
SET PSODRUG("COST")=$PIECE($GET(PSOX1),"^",6)
SET PSODRUG("UNIT")=$PIECE($GET(PSOX1),"^",8)
SET PSODRUG("EXPIRATION DATE")=$PIECE($GET(PSOX1),"^",9)
+10 if ('$GET(PSOFIN)&('$GET(PSOCOPY)))!($GET(PSOAC))
DO POST^PSODRG
IF $GET(PSORX("DFLG"))
KILL PSODRUG
NEW LST
if $GET(PSOAC)!($GET(NEWEDT))
QUIT
DO DSPL^PSOORFI1
SET VALMBCK="Q"
QUIT
+11 ;
+12 ; If current DAYS SUPPLY on the order > Maximum allowed for Dispense Drug prompt user for DAYS SUPPLY
+13 IF $$MXDAYSUP^PSSUTIL1(PSOY)<$GET(PSONEW("DAYS SUPPLY"))
DO DAYS^PSODIR1(.PSONEW)
+14 IF $GET(PSONEW("DFLG"))
KILL PSODRUG
SET OUT=1
GOTO EX
+15 ;
ETX DO REF
SET VALMBCK="R"
IF 'PSDC
SET VALMSG="NO dispense drugs tied to this orderable item!"
SET PSOQFLG=1
TX DO KV
KILL PSDC,PSI,X,Y,PSOX1,PSOY
+1 QUIT
EX MERGE PSODRUG=PSOBDR
KILL PSOBDR,PSOBDRG
SET PSOQFLG=1
SET VALMBCK="R"
DO MP1^PSOOREDX
+1 DO TX
QUIT
URX DO KV
SET DIR(0)="Y"
SET DIR("A")="Are You Sure You Want to Update Rx"
SET DIR("B")="Yes"
+1 DO ^DIR
if $DATA(DIRUT)!('Y)
SET DIRUT=1
+2 ;screens 4 order checks
IF Y
SET ^TMP("PSORXPO",$JOB,ORD,0)=1
+3 QUIT
REF ;
+1 ; Retrieving the Maximum Number of Refills allowed
+2 NEW MAXRF
SET MAXRF=$$MAXNUMRF^PSOUTIL(+$GET(PSODRUG("IEN")),+$GET(PSONEW("DAYS SUPPLY")),+$GET(PSONEW("PATIENT STATUS")),.CLOZPAT)
+3 IF ($GET(PSONEW("# OF REFILLS"))'="")&($GET(PSONEW("# OF REFILLS"))'>MAXRF)
Begin DoDot:1
+4 SET PSONEW("N# REF")=PSONEW("# OF REFILLS")
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=MAXRF
End DoDot:1
+7 QUIT
+8 ;
EDNEW ;
+1 NEW MAXRF
SET MAXRF=$$MAXNUMRF^PSOUTIL(+$GET(PSODRUG("IEN")),+$GET(PSONEW("DAYS SUPPLY")),+$GET(PSONEW("PATIENT STATUS")),.CLOZPAT)
+2 IF PSRF>MAXRF
Begin DoDot:1
+3 WRITE $CHAR(7),!!,PSRF_" refills are not correct for a "_PSDAYS_" day supply.",!,"Please enter correct # of refills for a "_PSDAYS_" day supply. Max refills allowed is "_MAXRF_".",!
+4 SET (PSMAX("MAX"),PSFMAX("MAX"))=MAXRF
SET (PSMAX("RF"),PSFMAX("RF"))=PSRF
SET (PSMAX("DAYS"),PSFMAX("DAYS"))=PSDAYS
SET (PSMAX,PSFMAX)=1
End DoDot:1
+5 KILL PSTMAX
DO EDSTAT
+6 QUIT
STATDAY KILL PSMAX,PSRMAX,PSFMAX,PSTMAX
SET PSDAYS=$PIECE(^PSRX(DA,0),"^",8)
SET PSRF=$PIECE(^PSRX(DA,0),"^",9)
SET PTST=$PIECE(^PS(53,X,0),"^")
SET PTDY=$PIECE(^(0),"^",3)
SET PTRF=$PIECE(^(0),"^",4)
EDSTAT IF PSRF>PTRF
WRITE !,$CHAR(7),PSRF_" refills are greater than "_PTRF_" allowed for "_$PIECE(PTST,"^")_" Rx Patient Status.",!
SET PSTMAX=1
SET PSTMAX("PTRF")=PTRF
SET PSTMAX("PSRF")=PSRF
SET PSTMAX("PT")=$PIECE(PTST,"^")
+1 QUIT
OERF SET DIR(0)="N^0:"_PSOX
SET DIR("A")="# OF REFILLS"
+1 SET DIR("B")=$SELECT($GET(POERR):PSONEW("# OF REFILLS"),$GET(PSONEW("N# REF"))]"":PSONEW("N# REF"),$GET(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),$GET(PSOX1)]""&(PSOX>PSOX1):PSOX1,1:PSOX)
+2 SET DIR("?")="Enter a whole number. The maximum is set by the Rx Patient Status because there is no Dispense Drug."
+3 DO ^DIR
if $DATA(DIRUT)
GOTO REFX
+4 SET (PSONEW("N# REF"),PSONEW("# OF REFILLS"))=Y
REFX if '$DATA(PSONEW("# OF REFILLS"))
SET PSONEW("# OF REFILLS")=$SELECT($GET(PSONEW("N# REF"))]"":PSONEW("N# REF"),$GET(PSOX1)]""&($GET(PSOX)>PSOX1):PSOX1,1:PSOX)
+1 KILL X,Y,PSOX,PSOX1,PSDY,PSDY1,DEA
KV KILL DIR,DIRUT,DUOUT,DTOUT
+1 QUIT
