- PSOORNW1 ;ISC BHAM/SAB - continuation of finish of new order ;28-Mar-2016 13:01;DU
- ;;7.0;OUTPATIENT PHARMACY;**23,46,78,117,131,133,172,1006,1013,148,222,268,206,1015,1021**;DEC 1997;Build 14
- ;Reference ^YSCL(603.01 supported by DBIA 2697
- ;Reference ^PS(55 supported by DBIA 2228
- ;Reference ^PSDRUG( supported by DBIA 221
- ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
- ; Modified - IHS/MSC/PLS - 04/02/08 - Line CT1+5 - Set PSONEW("NDC")
- ; Modified - IHS/MSC/PLS - 09/22/2011 - Line 2+6
- ; 12/06/2012 - Line EDNEW+6
- ; IHS/MSC/PLS - 03/28/2016 - Added REASK label, Line REASK+3
- 2 I $G(ORD) W !!,"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
- S (PSDC,PSI)=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 ;IHS/MSC/PLS - 09/22/2011
- F PSI=0:0 S PSI=$O(^PSDRUG("ASP",PSODRUG("OI"),PSI)) Q:'PSI I $$SCREEN^APSPMULT(PSI,,1) 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 ;IHS/MSC/PLS - 09/22/2011
- .S PSDC=PSDC+1 W !,PSDC_". "_$P(^PSDRUG(PSI,0),"^")_$S($P(^(0),"^",9):" (N/F)",1:"")
- .S PSDC(PSDC)=PSI
- 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("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")
- REASK ;IHS/MSC/PLS - 03/28/2016
- W ! D KV S DIR(0)="N^1:"_PSDC,DIR("A")="Select Drug by number" D ^DIR
- I $D(DIRUT) S OUT=1 G EX
- ;IHS/MSC/PLS - 03/28/2016 - CR5951
- I $$ERXONLY^APSPFNC6(+PSDC(Y)) D S Y=-1 G REASK
- .W !,"Drug is marked as ERX Only",*7,!
- 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
- .D KV S DIR(0)="Y",DIR("B")="YES",DIR("A",1)="You have changed the dispense drug from",DIR("A",2)=PSOBDR("NAME")_" to "_$P(^PSDRUG(+PSOY,0),"^")_".",DIR("A")="Do You want to Edit the SIG"
- .D ^DIR I $D(DIRUT) S OUT=1 Q
- .S:Y PSOCSIG=1
- .I 'Y D URX I $D(DIRUT) S OUT=1 Q
- D KV
- CT1 I $P($G(^PSDRUG(PSOY,"CLOZ1")),"^")="PSOCLO1",'$O(^YSCL(603.01,"C",PSODFN,0)) S VALMSG="Patient Not Registered in Clozapine Program",VALMBCK="Q" K PSOY,PSDC Q
- 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))
- ;IHS/MSC/PLS - 04/02/08 - Fix for NDC not changing when drug is changed.
- S PSONEW("NDC")=PSODRUG("NDC")
- S PSODRUG("DAW")=+$$GET1^DIQ(50,+PSOY,81)
- I $G(^PSDRUG(+PSOY,660))']"" D:'$G(PSOFIN)&('$G(PSOCOPY)) POST^PSODRG G ETX
- 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)) POST^PSODRG
- I $G(PSORX("DFLG")) K PSODRUG N LST Q:$G(PSOAC)!($G(NEWEDT)) D DSPL^PSOORFI1 S VALMBCK="Q" Q
- 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
- Q
- REF Q:'$D(PSODRUG("DEA"))!('$G(PSODRUG("IEN")))!('$G(^PS(55,PSODFN,"PS")))
- S PSONEW("CS")=0,PTRF=$S(+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",4)]""):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",4),1:5)
- F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSONEW("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSONEW("CS"),"^",2)=1
- I $P($G(PSONEW("CS")),"^",2)=1 S PSONEW("# OF REFILLS")=0 Q
- I +PSONEW("CS") D
- .S PSOX=$S($P($G(OR0),"^",11)>5:5,1:+$P($G(OR0),"^",11))
- .S PSOX=$S(PSOX>PTRF:PTRF,1:PSOX)
- .S PSONEW("# OF REFILLS")=PSOX
- E D
- .S PSOX=$S($P($G(OR0),"^",11)'>PTRF&($P($G(OR0),"^",11)'>11):11,1:PTRF)
- I '$D(CLOZPAT) I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2) S PSOX=0,PSONEW("# OF REFILLS")=0 K PSDY,PSDY1,PTRF Q
- I $D(CLOZPAT) S (PSOX,PSONEW("N# REF"),PSONEW("# OF REFILLS"))=$S(CLOZPAT=2&($G(PSONEW("# OF REFILLS"))>2):3,CLOZPAT&($G(PSONEW("# OF REFILLS"))>1):1,1:0),PSONEW("DAYS SUPPLY")=7,ORCHK=1 K PSDY,PSDY1,PTRF Q
- S PSONEW("# OF REFILLS")=$S($G(PSONEW("# OF REFILLS"))'="":$G(PSONEW("# OF REFILLS")),1:PSOX) K PSDY,PSDY1,PTRF
- Q
- EDNEW K PSMAX,PSFMAX F DEA=1:1 Q:$E(PSODEA,DEA)="" I $E(+PSODEA,DEA)>1,$E(+PSODEA,DEA)<6 S CS=1
- I CS D
- .S PSOX1=$S(PTRF>5:5,1:PTRF),PSOX=$S(PSOX1=5:5,1:PSOX1)
- .S PSOX=$S('PSOX:0,PSDAYS=90:1,1:PSOX),PSDY1=$S(PSDAYS<60:5,PSDAYS'<60&(PSDAYS'>89):2,PSDAYS=90:1,1:0) S MAX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- E D
- .S PSOX1=PTRF,PSOX=$S(PSOX1=11:11,1:PSOX1),PSOX=$S('PSOX:0,PSDAYS=90:3,1:PSOX)
- .;IHS/MSC/PLS - 12/06/2012
- .;S PSDY1=$S(PSDAYS<60:11,PSDAYS'<60&(PSDAYS'>89):5,PSDAYS=90:3,1:0) S MAX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- .S PSDY1=$S(PSDAYS<60:15,PSDAYS<90:5,PSDAYS=90:3,PSDAYS<168:2,PSDAYS<365:1,1:0) S MAX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- I PSRF>MAX 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 "_MAX_".",!
- .S (PSMAX("MAX"),PSFMAX("MAX"))=MAX,(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
- PSOORNW1 ;ISC BHAM/SAB - continuation of finish of new order ;28-Mar-2016 13:01;DU
- +1 ;;7.0;OUTPATIENT PHARMACY;**23,46,78,117,131,133,172,1006,1013,148,222,268,206,1015,1021**;DEC 1997;Build 14
- +2 ;Reference ^YSCL(603.01 supported by DBIA 2697
- +3 ;Reference ^PS(55 supported by DBIA 2228
- +4 ;Reference ^PSDRUG( supported by DBIA 221
- +5 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
- +6 ; Modified - IHS/MSC/PLS - 04/02/08 - Line CT1+5 - Set PSONEW("NDC")
- +7 ; Modified - IHS/MSC/PLS - 09/22/2011 - Line 2+6
- +8 ; 12/06/2012 - Line EDNEW+6
- +9 ; IHS/MSC/PLS - 03/28/2016 - Added REASK label, Line REASK+3
- 2 IF $GET(ORD)
- WRITE !!,"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 SET (PSDC,PSI)=0
- WRITE !!,"The following Drug(s) are available for selection:"
- +6 ;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 ;IHS/MSC/PLS - 09/22/2011
- +7 ;IHS/MSC/PLS - 09/22/2011
- FOR PSI=0:0
- SET PSI=$ORDER(^PSDRUG("ASP",PSODRUG("OI"),PSI))
- IF 'PSI
- QUIT
- IF $$SCREEN^APSPMULT(PSI,,1)
- 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
- 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("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
- REASK ;IHS/MSC/PLS - 03/28/2016
- +1 WRITE !
- DO KV
- SET DIR(0)="N^1:"_PSDC
- SET DIR("A")="Select Drug by number"
- DO ^DIR
- +2 IF $DATA(DIRUT)
- SET OUT=1
- GOTO EX
- +3 ;IHS/MSC/PLS - 03/28/2016 - CR5951
- +4 IF $$ERXONLY^APSPFNC6(+PSDC(Y))
- Begin DoDot:1
- +5 WRITE !,"Drug is marked as ERX Only",*7,!
- End DoDot:1
- SET Y=-1
- GOTO REASK
- +6 DO KV
- KILL PSOY
- SET PSOY=PSDC(Y)
- SET PSOY(0)=^PSDRUG(PSOY,0)
- SET PSOCSIG=0
- +7 IF $GET(PSOBDR("IEN"))
- IF PSOBDR("IEN")'=+PSOY
- IF $GET(ORD)
- Begin DoDot:1
- +8 DO KV
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A",1)="You have changed the dispense drug from"
- SET DIR("A",2)=PSOBDR("NAME")_" to "_$PIECE(^PSDRUG(+PSOY,0),"^")_"."
- SET DIR("A")="Do You want to Edit the SIG"
- +9 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- QUIT
- +10 IF Y
- SET PSOCSIG=1
- +11 IF 'Y
- DO URX
- IF $DATA(DIRUT)
- SET OUT=1
- QUIT
- End DoDot:1
- IF $DATA(DIRUT)
- GOTO EX
- +12 DO KV
- CT1 IF $PIECE($GET(^PSDRUG(PSOY,"CLOZ1")),"^")="PSOCLO1"
- IF '$ORDER(^YSCL(603.01,"C",PSODFN,0))
- SET VALMSG="Patient Not Registered in Clozapine Program"
- SET VALMBCK="Q"
- KILL PSOY,PSDC
- QUIT
- +1 SET PSODRUG("IEN")=+PSOY
- SET PSODRUG("VA CLASS")=$PIECE(PSOY(0),"^",2)
- SET PSODRUG("NAME")=$PIECE(PSOY(0),"^")
- +2 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
- +3 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)
- +4 SET PSODRUG("SIG")=$PIECE(PSOY(0),"^",5)
- SET PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$GET(PSOSITE))
- SET PSODRUG("STKLVL")=$GET(^PSDRUG(+PSOY,660.1))
- +5 ;IHS/MSC/PLS - 04/02/08 - Fix for NDC not changing when drug is changed.
- +6 SET PSONEW("NDC")=PSODRUG("NDC")
- +7 SET PSODRUG("DAW")=+$$GET1^DIQ(50,+PSOY,81)
- +8 IF $GET(^PSDRUG(+PSOY,660))']""
- IF '$GET(PSOFIN)&('$GET(PSOCOPY))
- DO POST^PSODRG
- GOTO ETX
- +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))
- DO POST^PSODRG
- +11 IF $GET(PSORX("DFLG"))
- KILL PSODRUG
- NEW LST
- IF $GET(PSOAC)!($GET(NEWEDT))
- QUIT
- DO DSPL^PSOORFI1
- SET VALMBCK="Q"
- QUIT
- 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 QUIT
- REF IF '$DATA(PSODRUG("DEA"))!('$GET(PSODRUG("IEN")))!('$GET(^PS(55,PSODFN,"PS")))
- QUIT
- +1 SET PSONEW("CS")=0
- SET PTRF=$SELECT(+$GET(^PS(55,PSODFN,"PS"))&($PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",4)]""):$PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",4),1:5)
- +2 FOR DEA=1:1
- IF $EXTRACT(PSODRUG("DEA"),DEA)=""
- QUIT
- IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
- IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
- SET $PIECE(PSONEW("CS"),"^")=1
- IF $EXTRACT(+PSODRUG("DEA"),DEA)=2
- SET $PIECE(PSONEW("CS"),"^",2)=1
- +3 IF $PIECE($GET(PSONEW("CS")),"^",2)=1
- SET PSONEW("# OF REFILLS")=0
- QUIT
- +4 IF +PSONEW("CS")
- Begin DoDot:1
- +5 SET PSOX=$SELECT($PIECE($GET(OR0),"^",11)>5:5,1:+$PIECE($GET(OR0),"^",11))
- +6 SET PSOX=$SELECT(PSOX>PTRF:PTRF,1:PSOX)
- +7 SET PSONEW("# OF REFILLS")=PSOX
- End DoDot:1
- +8 IF '$TEST
- Begin DoDot:1
- +9 SET PSOX=$SELECT($PIECE($GET(OR0),"^",11)'>PTRF&($PIECE($GET(OR0),"^",11)'>11):11,1:PTRF)
- End DoDot:1
- +10 IF '$DATA(CLOZPAT)
- IF PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2)
- SET PSOX=0
- SET PSONEW("# OF REFILLS")=0
- KILL PSDY,PSDY1,PTRF
- QUIT
- +11 IF $DATA(CLOZPAT)
- SET (PSOX,PSONEW("N# REF"),PSONEW("# OF REFILLS"))=$SELECT(CLOZPAT=2&($GET(PSONEW("# OF REFILLS"))>2):3,CLOZPAT&($GET(PSONEW("# OF REFILLS"))>1):1,1:0)
- SET PSONEW("DAYS SUPPLY")=7
- SET ORCHK=1
- KILL PSDY,PSDY1,PTRF
- QUIT
- +12 SET PSONEW("# OF REFILLS")=$SELECT($GET(PSONEW("# OF REFILLS"))'="":$GET(PSONEW("# OF REFILLS")),1:PSOX)
- KILL PSDY,PSDY1,PTRF
- +13 QUIT
- EDNEW KILL PSMAX,PSFMAX
- FOR DEA=1:1
- IF $EXTRACT(PSODEA,DEA)=""
- QUIT
- IF $EXTRACT(+PSODEA,DEA)>1
- IF $EXTRACT(+PSODEA,DEA)<6
- SET CS=1
- +1 IF CS
- Begin DoDot:1
- +2 SET PSOX1=$SELECT(PTRF>5:5,1:PTRF)
- SET PSOX=$SELECT(PSOX1=5:5,1:PSOX1)
- +3 SET PSOX=$SELECT('PSOX:0,PSDAYS=90:1,1:PSOX)
- SET PSDY1=$SELECT(PSDAYS<60:5,PSDAYS'<60&(PSDAYS'>89):2,PSDAYS=90:1,1:0)
- SET MAX=$SELECT(PSOX'>PSDY1:PSOX,1:PSDY1)
- End DoDot:1
- +4 IF '$TEST
- Begin DoDot:1
- +5 SET PSOX1=PTRF
- SET PSOX=$SELECT(PSOX1=11:11,1:PSOX1)
- SET PSOX=$SELECT('PSOX:0,PSDAYS=90:3,1:PSOX)
- +6 ;IHS/MSC/PLS - 12/06/2012
- +7 ;S PSDY1=$S(PSDAYS<60:11,PSDAYS'<60&(PSDAYS'>89):5,PSDAYS=90:3,1:0) S MAX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- +8 SET PSDY1=$SELECT(PSDAYS<60:15,PSDAYS<90:5,PSDAYS=90:3,PSDAYS<168:2,PSDAYS<365:1,1:0)
- SET MAX=$SELECT(PSOX'>PSDY1:PSOX,1:PSDY1)
- End DoDot:1
- +9 IF PSRF>MAX
- Begin DoDot:1
- +10 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 "_MAX_".",!
- +11 SET (PSMAX("MAX"),PSFMAX("MAX"))=MAX
- SET (PSMAX("RF"),PSFMAX("RF"))=PSRF
- SET (PSMAX("DAYS"),PSFMAX("DAYS"))=PSDAYS
- SET (PSMAX,PSFMAX)=1
- End DoDot:1
- +12 KILL PSTMAX
- DO EDSTAT
- +13 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
