PSOHELP1 ;BIR/SAB-OUTPATIENT HELP TEXT/UTILITY ROUTINE 2 ;11/09/92
;;7.0;OUTPATIENT PHARMACY;**23,36,88,146,227,222,408,444**;DEC 1997;Build 34
;External reference ^DIC(19.2 supported by DBIA 1472
;External reference ^PSDRUG( supported by DBIA 221
;External reference ^PS(55 supported by DBIA 2228
;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
;
2001 N PSOHLP S PSOHLP(1,"F")="!!"
S PSOHLP(1)="Enter the lowest prescription number for this site."
S PSOHLP(2,"F")="!"
S PSOHLP(2)="If this is the first time you are entering this field,"
S PSOHLP(3,"F")="!"
S PSOHLP(3)="you should pick a number LARGER than the last prescription number used."
S PSOHLP(4,"F")="!!"
D WRITE
Q
;
2002 N PSOHLP S PSOHLP(1,"F")="!!"
S PSOHLP(1)="Enter the largest acceptable prescription number for this site."
S PSOHLP(2,"F")="!"
S PSOHLP(2)="The difference between this number and the lowest prescription"
S PSOHLP(3,"F")="!"
S PSOHLP(3)="number should be substantial. The system will not allow numbers"
S PSOHLP(4,"F")="!"
S PSOHLP(4)="larger than the one you choose. It will give a warning message"
S PSOHLP(5,"F")="!"
S PSOHLP(5)="and not allow entry of any more prescriptions."
S PSOHLP(6,"F")="!!"
D WRITE
Q
;
2003 N PSOHLP S PSOHLP(1,"F")="!!"
S PSOHLP(1)="Enter the last prescription number used."
S PSOHLP(2,"F")="!"
S PSOHLP(2)="If you are entering this for the first time, this number"
S PSOHLP(3,"F")="!"
S PSOHLP(3)="should be the same as the number you entered for LOW RX#."
S PSOHLP(4,"F")="!"
S PSOHLP(4)="The system will take this number, increment it by one"
S PSOHLP(5,"F")="!"
S PSOHLP(5)="until it finds a number that has not been used, and then"
S PSOHLP(6,"F")="!"
S PSOHLP(6)="use that number for the next prescription."
S PSOHLP(7,"F")="!!"
D WRITE
Q
WRITE ;EN^DDIOL call
D EN^DDIOL(.PSOHLP) K PSOHLP
Q
AUTOQ ;entry point to queue all background jobs
D:0 RESET1^PSOTPHL1 ;placed out of order by PSO*7*227
D AUTO^PSOAUTOC ;ques auto cancel job
D SETUP^PSOAUTOC ;ques nightly cost compile
D SETUP1^PSOAUTOC ;ques nightly mgmt compile
D QUP,CLO ;ques amis compile
D SETUP^PSOHLEXP ;ques exipration status update
D AUTO^PSOSUDEL ;ques job to deleted rxs printed from 52.5
D AUTO^PSOSPML0 ;ques job to transmit CS Rx's to the states
CLO K Y,C,D,D0,DI,DQ,DA,DIE,DR,DIC,Y,X,PSOTM,PSOOPTN,%DT,PSOPTN
Q
QUP K %DT,DIC,DTOUT S DIC(0)="XZM",DIC="^DIC(19.2,",X="PSO AMIS COMPILE" D ^DIC
I +Y>0 D EDIT^XUTMOPT("PSO AMIS COMPILE") G CLO
D RESCH^XUTMOPT("PSO AMIS COMPILE","","","24H","L"),EDIT^XUTMOPT("PSO AMIS COMPILE")
Q
EXP ;reset "P","A" xref in 55 from cancel option
Q:$G(REA)="C"
S PCD=+$P($G(^PSRX(DA,3)),"^",5) I 'PCD D K EXP,PCD,IFN Q
.S (IFN,EXP)=0
.F S EXP=$O(^PS(55,PSODFN,"P","A",EXP)) Q:'EXP F S IFN=$O(^PS(55,PSODFN,"P","A",EXP,IFN)) Q:'IFN I IFN=DA K ^PS(55,PSODFN,"P","A",EXP,DA) S ^PS(55,PSODFN,"P","A",$P(^PSRX(DA,2),"^",6),DA)=""
K ^PS(55,PSODFN,"P","A",PCD,DA) S ^PS(55,PSODFN,"P","A",$P(^PSRX(DA,2),"^",6),DA)="",$P(^PSRX(DA,3),"^",5)=""
K PCD Q
SREF ;set "P","A" xref in 55 from fileman
I $P($G(^PSRX(X,"STA")),"^")=12,'$P($G(^PSRX(X,3)),"^",5) D Q
.F PX=0:0 S PA=$O(^PSRX(X,"A",PX)) Q:'PX S:$P(^PSRX(X,"A",PX,0),"^",2)="C" PCD=$P($P(^PSRX(X,"A",PX,0),"^"),".")
.I $G(PCD) S ^PS(55,DA(1),"P","A",PCD,X)="",$P(^PSRX(X,3),"^",5)=PCD
.E S:$P($G(^PSRX(X,2)),"^",6) ^PS(55,DA(1),"P","A",$P(^PSRX(X,2),"^",6),X)=""
.K PCD,PX
I $P($G(^PSRX(X,"STA")),"^")=12,$P($G(^PSRX(X,3)),"^",5) S ^PS(55,DA(1),"P","A",$P(^PSRX(X,3),"^",5),X)="" Q
S:$P($G(^PSRX(X,2)),"^",6) ^PS(55,DA(1),"P","A",$P(^PSRX(X,2),"^",6),X)=""
Q
KREF ;kill "P","A" xref in 55 from fileman
K:+$P($G(^PSRX(X,2)),"^",6) ^PS(55,DA(1),"P","A",+$P(^PSRX(X,2),"^",6),X)
I $P($G(^PSRX(X,"STA")),"^")=12,'$P($G(^PSRX(X,3)),"^",5) D K PCD,PX Q
.F PX=0:0 S A=$O(^PSRX(X,"A",PX)) Q:'PX S:$P(^PSRX(X,"A",PX,0),"^",2)="C" PCD=$P($P(^PSRX(X,"A",PX,0),"^"),".")
.I $G(PCD) K ^PS(55,DA(1),"P","A",PCD,X)
I $P($G(^PSRX(X,"STA")),"^")=12,$P($G(^PSRX(X,3)),"^",5) K ^PS(55,DA(1),"P","A",$P(^PSRX(X,3),"^",5),X)
Q
DAYS ; INPUT TRANSFORM for DAYS SUPPLY field (#8) in the PRESCRIPTION file (#52)
N PSMAX,DRUGIEN
S DRUGIEN=+$P(^PSRX(DA,0),"^",6)
I $P($G(^PSDRUG(DRUGIEN,0)),"^",4),$P(^PSRX(DA,0),"^",7)/X>$P($G(^PSDRUG(DRUGIEN,0)),"^",4) D EN^DDIOL("Max Daily Dose of "_$P($G(^(0)),"^",4)_" Exceeded","","$C(7),!?5") D EN^DDIOL(" ","","!")
S PSDAYS=$P(^PSRX(DA,0),"^",8),PSRF=+$P(^(0),"^",9),PTST=$G(^PS(53,$P(^(0),"^",3),0)),PTDY=$P(PTST,"^",3),PTRF=$P(PTST,"^",4),PSODEA=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^",3)
S CS=0 I (PSODEA[2)!(PSODEA[3)!(PSODEA[4)!(PSODEA[5) S CS=1
I $G(CLOZPAT)=1,'PSRF,X>14 K X D EN^DDIOL(" 14 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
I $G(CLOZPAT)=0,'PSRF,X>7 K X D EN^DDIOL(" 7 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
I $G(CLOZPAT)=1,X'=7,PSRF K X D EN^DDIOL(" Day Supply Must Equal 7 with 1 refill for Clozapine Prescriptions.","","$C(7),!!") Q
I $G(CLOZPAT)=1,'PSRF,X>14 K X D EN^DDIOL(" 14 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
I $G(CLOZPAT)=2,'PSRF,X>28 K X D EN^DDIOL(" 28 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
I $G(CLOZPAT)=2,PSRF=1,X>14 K X D EN^DDIOL(" Day Supply Must Equal 14 with 1 refill for Clozapine Prescriptions.","","$C(7),!!") Q
I $G(CLOZPAT)=2,PSRF=3,X>7 K X D EN^DDIOL(" Day Supply Must Equal 7 with 3 refill for Clozapine Prescriptions.","","$C(7),!!") Q
;
; Checking Maximum Day Supply value for the Drug
I X>$$MXDAYSUP^PSSUTIL1(DRUGIEN) D Q
. K X D EN^DDIOL(" DAYS SUPPLY exceeds the maximum allowed ("_$$MXDAYSUP^PSSUTIL1(DRUGIEN)_") for "_$$GET1^DIQ(50,DRUGIEN,.01)_".","","$C(7),!!") Q
;
; Retrieving the Maximum Number of Refills allowed
S MAX=$$MAXNUMRF^PSOUTIL(DRUGIEN,X,+$P(^PSRX(DA,0),"^",3),.CLOZPAT)
I PSRF>MAX S DS=X D
.D FULL^VALM1,EN^DDIOL(PSRF_" refills are not correct for a "_DS_" day supply.","","$C(7),!!")
.D EN^DDIOL("Please enter correct # of refills for a "_DS_" day supply. Max refills allowed is "_MAX_".","","!") D EN^DDIOL(" ","","!")
.K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,X,Y,DIRUT S VALMBCK="R"
K PSTMAX,DS D EDSTAT^PSOUTLA
K MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,PTRF,PTDY
Q
DAYS1 ; INPUT TRANSFORM for DAYS SUPPLY field (#1.1) in the REFILL sub-file (#52.1) of the PRESCRIPTION file (#52)
N PSRMAX,DRUGIEN,CS
S DRUGIEN=+$P(^PSRX(DA(1),0),"^",6)
S PSRF=$P(^PSRX(DA(1),0),"^",9),PTST=$G(^PS(53,$P(^(0),"^",3),0)),PTDY=$P(PTST,"^",3),PTRF=$P(PTST,"^",4)
S PSDAYS=$P(^PSRX(DA(1),1,DA,0),"^",10),PSODEA=$P(^PSDRUG(DRUGIEN,0),"^",3)
S CS=0 I (PSODEA[2)!(PSODEA[3)!(PSODEA[4)!(PSODEA[5) S CS=1
;
; Checking Maximum Day Supply value for the Drug
I X>$$MXDAYSUP^PSSUTIL1(DRUGIEN) D Q
. K X D EN^DDIOL(" DAYS SUPPLY exceeds the maximum allowed ("_$$MXDAYSUP^PSSUTIL1(DRUGIEN)_") for "_$$GET1^DIQ(50,DRUGIEN,.01)_".","","$C(7),!!") Q
;
K DS,MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,PTDY,PTRF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHELP1 7186 printed Oct 16, 2024@18:30:15 Page 2
PSOHELP1 ;BIR/SAB-OUTPATIENT HELP TEXT/UTILITY ROUTINE 2 ;11/09/92
+1 ;;7.0;OUTPATIENT PHARMACY;**23,36,88,146,227,222,408,444**;DEC 1997;Build 34
+2 ;External reference ^DIC(19.2 supported by DBIA 1472
+3 ;External reference ^PSDRUG( supported by DBIA 221
+4 ;External reference ^PS(55 supported by DBIA 2228
+5 ;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
+6 ;
2001 NEW PSOHLP
SET PSOHLP(1,"F")="!!"
+1 SET PSOHLP(1)="Enter the lowest prescription number for this site."
+2 SET PSOHLP(2,"F")="!"
+3 SET PSOHLP(2)="If this is the first time you are entering this field,"
+4 SET PSOHLP(3,"F")="!"
+5 SET PSOHLP(3)="you should pick a number LARGER than the last prescription number used."
+6 SET PSOHLP(4,"F")="!!"
+7 DO WRITE
+8 QUIT
+9 ;
2002 NEW PSOHLP
SET PSOHLP(1,"F")="!!"
+1 SET PSOHLP(1)="Enter the largest acceptable prescription number for this site."
+2 SET PSOHLP(2,"F")="!"
+3 SET PSOHLP(2)="The difference between this number and the lowest prescription"
+4 SET PSOHLP(3,"F")="!"
+5 SET PSOHLP(3)="number should be substantial. The system will not allow numbers"
+6 SET PSOHLP(4,"F")="!"
+7 SET PSOHLP(4)="larger than the one you choose. It will give a warning message"
+8 SET PSOHLP(5,"F")="!"
+9 SET PSOHLP(5)="and not allow entry of any more prescriptions."
+10 SET PSOHLP(6,"F")="!!"
+11 DO WRITE
+12 QUIT
+13 ;
2003 NEW PSOHLP
SET PSOHLP(1,"F")="!!"
+1 SET PSOHLP(1)="Enter the last prescription number used."
+2 SET PSOHLP(2,"F")="!"
+3 SET PSOHLP(2)="If you are entering this for the first time, this number"
+4 SET PSOHLP(3,"F")="!"
+5 SET PSOHLP(3)="should be the same as the number you entered for LOW RX#."
+6 SET PSOHLP(4,"F")="!"
+7 SET PSOHLP(4)="The system will take this number, increment it by one"
+8 SET PSOHLP(5,"F")="!"
+9 SET PSOHLP(5)="until it finds a number that has not been used, and then"
+10 SET PSOHLP(6,"F")="!"
+11 SET PSOHLP(6)="use that number for the next prescription."
+12 SET PSOHLP(7,"F")="!!"
+13 DO WRITE
+14 QUIT
WRITE ;EN^DDIOL call
+1 DO EN^DDIOL(.PSOHLP)
KILL PSOHLP
+2 QUIT
AUTOQ ;entry point to queue all background jobs
+1 ;placed out of order by PSO*7*227
if 0
DO RESET1^PSOTPHL1
+2 ;ques auto cancel job
DO AUTO^PSOAUTOC
+3 ;ques nightly cost compile
DO SETUP^PSOAUTOC
+4 ;ques nightly mgmt compile
DO SETUP1^PSOAUTOC
+5 ;ques amis compile
DO QUP
DO CLO
+6 ;ques exipration status update
DO SETUP^PSOHLEXP
+7 ;ques job to deleted rxs printed from 52.5
DO AUTO^PSOSUDEL
+8 ;ques job to transmit CS Rx's to the states
DO AUTO^PSOSPML0
CLO KILL Y,C,D,D0,DI,DQ,DA,DIE,DR,DIC,Y,X,PSOTM,PSOOPTN,%DT,PSOPTN
+1 QUIT
QUP KILL %DT,DIC,DTOUT
SET DIC(0)="XZM"
SET DIC="^DIC(19.2,"
SET X="PSO AMIS COMPILE"
DO ^DIC
+1 IF +Y>0
DO EDIT^XUTMOPT("PSO AMIS COMPILE")
GOTO CLO
+2 DO RESCH^XUTMOPT("PSO AMIS COMPILE","","","24H","L")
DO EDIT^XUTMOPT("PSO AMIS COMPILE")
+3 QUIT
EXP ;reset "P","A" xref in 55 from cancel option
+1 if $GET(REA)="C"
QUIT
+2 SET PCD=+$PIECE($GET(^PSRX(DA,3)),"^",5)
IF 'PCD
Begin DoDot:1
+3 SET (IFN,EXP)=0
+4 FOR
SET EXP=$ORDER(^PS(55,PSODFN,"P","A",EXP))
if 'EXP
QUIT
FOR
SET IFN=$ORDER(^PS(55,PSODFN,"P","A",EXP,IFN))
if 'IFN
QUIT
IF IFN=DA
KILL ^PS(55,PSODFN,"P","A",EXP,DA)
SET ^PS(55,PSODFN,"P","A",$PIECE(^PSRX(DA,2),"^",6),DA)=""
End DoDot:1
KILL EXP,PCD,IFN
QUIT
+5 KILL ^PS(55,PSODFN,"P","A",PCD,DA)
SET ^PS(55,PSODFN,"P","A",$PIECE(^PSRX(DA,2),"^",6),DA)=""
SET $PIECE(^PSRX(DA,3),"^",5)=""
+6 KILL PCD
QUIT
SREF ;set "P","A" xref in 55 from fileman
+1 IF $PIECE($GET(^PSRX(X,"STA")),"^")=12
IF '$PIECE($GET(^PSRX(X,3)),"^",5)
Begin DoDot:1
+2 FOR PX=0:0
SET PA=$ORDER(^PSRX(X,"A",PX))
if 'PX
QUIT
if $PIECE(^PSRX(X,"A",PX,0),"^",2)="C"
SET PCD=$PIECE($PIECE(^PSRX(X,"A",PX,0),"^"),".")
+3 IF $GET(PCD)
SET ^PS(55,DA(1),"P","A",PCD,X)=""
SET $PIECE(^PSRX(X,3),"^",5)=PCD
+4 IF '$TEST
if $PIECE($GET(^PSRX(X,2)),"^",6)
SET ^PS(55,DA(1),"P","A",$PIECE(^PSRX(X,2),"^",6),X)=""
+5 KILL PCD,PX
End DoDot:1
QUIT
+6 IF $PIECE($GET(^PSRX(X,"STA")),"^")=12
IF $PIECE($GET(^PSRX(X,3)),"^",5)
SET ^PS(55,DA(1),"P","A",$PIECE(^PSRX(X,3),"^",5),X)=""
QUIT
+7 if $PIECE($GET(^PSRX(X,2)),"^",6)
SET ^PS(55,DA(1),"P","A",$PIECE(^PSRX(X,2),"^",6),X)=""
+8 QUIT
KREF ;kill "P","A" xref in 55 from fileman
+1 if +$PIECE($GET(^PSRX(X,2)),"^",6)
KILL ^PS(55,DA(1),"P","A",+$PIECE(^PSRX(X,2),"^",6),X)
+2 IF $PIECE($GET(^PSRX(X,"STA")),"^")=12
IF '$PIECE($GET(^PSRX(X,3)),"^",5)
Begin DoDot:1
+3 FOR PX=0:0
SET A=$ORDER(^PSRX(X,"A",PX))
if 'PX
QUIT
if $PIECE(^PSRX(X,"A",PX,0),"^",2)="C"
SET PCD=$PIECE($PIECE(^PSRX(X,"A",PX,0),"^"),".")
+4 IF $GET(PCD)
KILL ^PS(55,DA(1),"P","A",PCD,X)
End DoDot:1
KILL PCD,PX
QUIT
+5 IF $PIECE($GET(^PSRX(X,"STA")),"^")=12
IF $PIECE($GET(^PSRX(X,3)),"^",5)
KILL ^PS(55,DA(1),"P","A",$PIECE(^PSRX(X,3),"^",5),X)
+6 QUIT
DAYS ; INPUT TRANSFORM for DAYS SUPPLY field (#8) in the PRESCRIPTION file (#52)
+1 NEW PSMAX,DRUGIEN
+2 SET DRUGIEN=+$PIECE(^PSRX(DA,0),"^",6)
+3 IF $PIECE($GET(^PSDRUG(DRUGIEN,0)),"^",4)
IF $PIECE(^PSRX(DA,0),"^",7)/X>$PIECE($GET(^PSDRUG(DRUGIEN,0)),"^",4)
DO EN^DDIOL("Max Daily Dose of "_$PIECE($GET(^(0)),"^",4)_" Exceeded","","$C(7),!?5")
DO EN^DDIOL(" ","","!")
+4 SET PSDAYS=$PIECE(^PSRX(DA,0),"^",8)
SET PSRF=+$PIECE(^(0),"^",9)
SET PTST=$GET(^PS(53,$PIECE(^(0),"^",3),0))
SET PTDY=$PIECE(PTST,"^",3)
SET PTRF=$PIECE(PTST,"^",4)
SET PSODEA=$PIECE(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0),"^",3)
+5 SET CS=0
IF (PSODEA[2)!(PSODEA[3)!(PSODEA[4)!(PSODEA[5)
SET CS=1
+6 IF $GET(CLOZPAT)=1
IF 'PSRF
IF X>14
KILL X
DO EN^DDIOL(" 14 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!")
QUIT
+7 IF $GET(CLOZPAT)=0
IF 'PSRF
IF X>7
KILL X
DO EN^DDIOL(" 7 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!")
QUIT
+8 IF $GET(CLOZPAT)=1
IF X'=7
IF PSRF
KILL X
DO EN^DDIOL(" Day Supply Must Equal 7 with 1 refill for Clozapine Prescriptions.","","$C(7),!!")
QUIT
+9 IF $GET(CLOZPAT)=1
IF 'PSRF
IF X>14
KILL X
DO EN^DDIOL(" 14 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!")
QUIT
+10 IF $GET(CLOZPAT)=2
IF 'PSRF
IF X>28
KILL X
DO EN^DDIOL(" 28 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!")
QUIT
+11 IF $GET(CLOZPAT)=2
IF PSRF=1
IF X>14
KILL X
DO EN^DDIOL(" Day Supply Must Equal 14 with 1 refill for Clozapine Prescriptions.","","$C(7),!!")
QUIT
+12 IF $GET(CLOZPAT)=2
IF PSRF=3
IF X>7
KILL X
DO EN^DDIOL(" Day Supply Must Equal 7 with 3 refill for Clozapine Prescriptions.","","$C(7),!!")
QUIT
+13 ;
+14 ; Checking Maximum Day Supply value for the Drug
+15 IF X>$$MXDAYSUP^PSSUTIL1(DRUGIEN)
Begin DoDot:1
+16 KILL X
DO EN^DDIOL(" DAYS SUPPLY exceeds the maximum allowed ("_$$MXDAYSUP^PSSUTIL1(DRUGIEN)_") for "_$$GET1^DIQ(50,DRUGIEN,.01)_".","","$C(7),!!")
QUIT
End DoDot:1
QUIT
+17 ;
+18 ; Retrieving the Maximum Number of Refills allowed
+19 SET MAX=$$MAXNUMRF^PSOUTIL(DRUGIEN,X,+$PIECE(^PSRX(DA,0),"^",3),.CLOZPAT)
+20 IF PSRF>MAX
SET DS=X
Begin DoDot:1
+21 DO FULL^VALM1
DO EN^DDIOL(PSRF_" refills are not correct for a "_DS_" day supply.","","$C(7),!!")
+22 DO EN^DDIOL("Please enter correct # of refills for a "_DS_" day supply. Max refills allowed is "_MAX_".","","!")
DO EN^DDIOL(" ","","!")
+23 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR,X,Y,DIRUT
SET VALMBCK="R"
End DoDot:1
+24 KILL PSTMAX,DS
DO EDSTAT^PSOUTLA
+25 KILL MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,PTRF,PTDY
+26 QUIT
DAYS1 ; INPUT TRANSFORM for DAYS SUPPLY field (#1.1) in the REFILL sub-file (#52.1) of the PRESCRIPTION file (#52)
+1 NEW PSRMAX,DRUGIEN,CS
+2 SET DRUGIEN=+$PIECE(^PSRX(DA(1),0),"^",6)
+3 SET PSRF=$PIECE(^PSRX(DA(1),0),"^",9)
SET PTST=$GET(^PS(53,$PIECE(^(0),"^",3),0))
SET PTDY=$PIECE(PTST,"^",3)
SET PTRF=$PIECE(PTST,"^",4)
+4 SET PSDAYS=$PIECE(^PSRX(DA(1),1,DA,0),"^",10)
SET PSODEA=$PIECE(^PSDRUG(DRUGIEN,0),"^",3)
+5 SET CS=0
IF (PSODEA[2)!(PSODEA[3)!(PSODEA[4)!(PSODEA[5)
SET CS=1
+6 ;
+7 ; Checking Maximum Day Supply value for the Drug
+8 IF X>$$MXDAYSUP^PSSUTIL1(DRUGIEN)
Begin DoDot:1
+9 KILL X
DO EN^DDIOL(" DAYS SUPPLY exceeds the maximum allowed ("_$$MXDAYSUP^PSSUTIL1(DRUGIEN)_") for "_$$GET1^DIQ(50,DRUGIEN,.01)_".","","$C(7),!!")
QUIT
End DoDot:1
QUIT
+10 ;
+11 KILL DS,MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,PTDY,PTRF
+12 QUIT
