Index: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORXED.m
===================================================================
--- WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORXED.m	(revision 613)
+++ WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORXED.m	(revision 623)
@@ -1,124 +1,124 @@
-PSORXED	;IHS/DSD/JCM-edit rx utility ; 5/18/07 2:53pm
-	;;7.0;OUTPATIENT PHARMACY;**2,16,21,26,56,71,125,201,246**;DEC 1997;Build 12
-	;External reference to ^PSXEDIT supported by DBIA 2209
-	;External reference to ^DD(52 supported by DBIA 999
-	;External reference to ^PSDRUG supported by DBIA 221
-	;External reference to ^PS(55 supported by DBIA 2228
-START	;this entry point is no longer used.
-	;D INIT,LKUP G:PSORXED("QFLG") END D PARSE,EOJ G START
-END	D EOJ
-	Q
-INIT	S PSORXED("QFLG")=0 Q
-LKUP	; this line of code is no longer used S PSONUM="RX",PSONUM("A")="EDIT",PSOQFLG=0 D EN1^PSONUM I PSOQFLG!($Q(PSOLIST)']"") S PSORXED("QFLG")=1
-	K PSOQFLG Q
-	;
-PARSE	F PSORXED("LIST")=1:1 Q:'$D(PSOLIST(PSORXED("LIST")))!PSORXED("QFLG")  F PSORXED("I")=1:1:$L(PSOLIST(PSORXED("LIST"))) S PSORXED("IRXN")=$P(PSOLIST(PSORXED("LIST")),",",PSORXED("I")) D:+PSORXED("IRXN") PROCESS
-	Q
-PROCESS	S PSORXED("DFLG")=0 G:$G(^PSRX(PSORXED("IRXN"),0))']"" PROCESSX
-	S PSORXED("RX0")=^PSRX(PSORXED("IRXN"),0),PSORXED("RX2")=^(2),PSORXED("RX3")=^(3),PSOSIG=$G(^PSRX(PSORXED("IRXN"),"SIG")),PSODAYS=$P(PSORXED("RX0"),"^",8)
-	S (I,RFED,RFDT)=0 F  S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I  S RFED=I,PSORXED("RX1")=^PSRX(PSORXED("IRXN"),1,I,0),RFDT=$P(^(0),"^"),PSODAYS=$P(^(0),"^",10) S:$P(^(0),"^",17) PSONEW("PROVIDER NAME")=$P(^VA(200,$P(^(0),"^",17),0),"^")
-	S PSORXST=+$P($G(^PS(53,+$P(PSORXED("RX0"),"^",3),0)),"^",7) N DA S DA=PSORXED("IRXN") D EN^PSORXPR
-	D CHECK G:PSORXED("DFLG") PROCESSX
-	N X S X="PSXEDIT" X ^%ZOSF("TEST") K X I $T D ^PSXEDIT I $G(PSXOUT) K PSXOUT G L1
-	D DIE^PSORXED1
-L1	D LOG,POST
-PROCESSX	Q
-CHECK	Q  L +^PSRX(PSORXED("IRXN")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W $C(7),!!,"Rx Number is Locked by Another User!",! S PSORXED("DFLG")=1 H 5 Q
-	I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT D  G CHECKX
-	. W !,$C(7),"This drug has been inactivated. ",! S PSORXED("DFLG")=1 Q
-	K PSPOP I $G(PSODIV),$P(PSORXED("RX2"),"^",9)'=PSOSITE S PSPRXN=PSORXED("IRXN") D CHK1^PSOUTLA I $G(PSPOP)=1 S PSORXED("DFLG")=1 G CHECKX
-	;
-	I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=14!($P(^("STA"),"^")=15) S PSORXED("DFLG")=1 W !!,$C(7),"Discontinued prescriptions cannot be edited.",! G CHECKX
-	I $D(^PS(52.4,"B",PSORXED("IRXN"))) S PSORXED("DFLG")=1 W !!,$C(7),"Non-verified prescriptions cannot be edited.",!
-CHECKX	K PSPOP,DIR,DTOUT,DUOUT,Y,X Q
-LOG	K PSFROM S DA=PSORXED("IRXN"),(PSRX0,RX0)=PSORXED("RX0"),QTY=$P(RX0,"^",7),QTY=QTY-$P(^PSRX(DA,0),"^",7) K ZD(DA) S:'$O(^PSRX(DA,1,0)) ZD(DA)=$P(^PSRX(DA,2),"^",2)
-	S COM="" F I=3,4,5:1:13,17 I $P(PSRX0,"^",I)'=$P(^PSRX(DA,0),"^",I) S PSI=$S(I=13:1,1:I),COM=COM_$P(^DD(52,PSI,0),"^")_" ("_$P(PSRX0,"^",I)_"),"
-	I $P(PSORXED("RX2"),"^",2)'=$P(^PSRX(DA,2),"^",2) S COM=COM_$P(^DD(52,22,0),"^")_" ("_$P(PSORXED("RX2"),"^",2)_"),"
-	I $P(PSORXED("RX3"),"^",7)'=$P(^PSRX(DA,3),"^",7) S COM=COM_$P(^DD(52,12,0),"^")_" ("_$P(PSORXED("RX3"),"^",7)_"),"
-	I PSOSIG'=$P($G(^PSRX(DA,"SIG")),"^") S COM=COM_$P(^DD(52,10,0),"^")_" ("_PSOSIG_"),"
-	I PSOTRN'=$G(^PSRX(DA,"TN")) S COM=COM_$P(^DD(52,6.5,0),"^")_" ("_PSOTRN_"),"
-	G:COM="" LOGX K PSRX0 S X=$S($D(PSOCLC):PSOCLC,1:DUZ)
-	D FILL,LBL D:$G(PSOEDITL)=2&($P($G(^PSRX(DA,"STA")),"^")'=5)&('$G(RXRP(DA)))&('$G(PSOSIGFL)) ASKL
-	S K=1,D1=0 F Z=0:0 S Z=$O(^PSRX(DA,"A",Z)) Q:'Z  S D1=Z,K=K+1
-	S D1=D1+1 S:'($D(^PSRX(DA,"A",0))#2) ^(0)="^52.3DA^^^" S ^(0)=$P(^(0),"^",1,2)_"^"_D1_"^"_K
-	S ^PSRX(DA,"A",D1,0)=DT_"^E^"_$G(DUZ)_"^0^"_COM
-	I QTY,$P(^PSRX(DA,2),"^",13) S ^PSDRUG($P(^PSRX(DA,0),"^",6),660.1)=$S($D(^PSDRUG(+$P(^PSRX(DA,0),"^",6),660.1)):^(660.1)+QTY,1:QTY)
-	S:$P(RX0,"^",6)'=$P(^PSRX(DA,0),"^",6) ^PSDRUG(+$P(^PSRX(DA,0),"^",6),660.1)=$S($D(^PSDRUG(+$P(RX0,"^",6),660.1)):^(660.1)+$P(RX0,"^",7),1:$P(RX0,"^",7))
-	S RX0=^PSRX(DA,0),RX2=^(2),J=DA,OEXDT=+$P(RX2,"^",6) D ^PSOEXDT S NEXDT=+$P(RX2,"^",6) I OEXDT'=NEXDT D
-	.K ^PSRX("AG",OEXDT,DA) S ^PSRX("AG",NEXDT,DA)=""
-	.S D=+$P(RX0,"^",2) K ^PS(55,D,"P","A",OEXDT,DA) S ^PS(55,D,"P","A",NEXDT,DA)=""
-	K D,OEXDT,NEXDT
-	G:+$P(^PSRX(J,"STA"),"^")!($G(PSOEDITL)=1) LOGX S RXFL(PSORXED("IRXN"))=$S($G(PSOEDITF):$G(PSOEDITF),1:0) I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSORXED("IRXN")_"," D SETRP G LOGX
-	G:$G(PSOEDITL)=1 LOGX
-	F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1  S PSOX2=PSOX1
-	I $L(PSORX("PSOL",PSOX2))+$L(PSORXED("IRXN"))<220 D  G LOGX
-	.I PSORX("PSOL",PSOX2)'[PSORXED("IRXN")_"," S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSORXED("IRXN")_"," D SETRP
-	E  I $G(PSORX("PSOL",PSOX2+1))'[PSORXED("IRXN")_"," S PSORX("PSOL",PSOX2+1)=PSORXED("IRXN")_"," D SETRP   ;;PSO*7*246
-LOGX	K PSOEDITF,PSOEDITR,PSOEDITL D:$G(RFED) ^PSORXED1
-	Q
-POST	; D NEXT D:$G(^PSRX(PSORXED("IRXN"),"IB"))]"" COPAY K PSODAYS,PSORXST
-	D NEXT D COPAY K PSODAYS,PSORXST
-	Q
-COPAY	S DA=PSORXED("IRXN") I 'RFD,PSODAYS'=+$P(^PSRX(DA,0),"^",8) I +$G(^PSRX(DA,"IB"))!($P($G(^PSRX(DA,"PFS")),"^",2)) D CPCK G RXST
-	I RFD,+$G(^PSRX(DA,1,RFD,0)),PSODAYS'=$P($G(^PSRX(DA,1,RFD,0)),"^",10) I +$G(^PSRX(DA,"IB"))!($P($G(^PSRX(DA,1,RFD,"PFS")),"^",2)) D CPCK
-RXST	G:PSORXST=+$P($G(^PS(53,+$P(^PSRX(DA,0),"^",3),0)),"^",7) COPAYX
-	W !,$C(7),"Patient Status field for this Rx has been changed from a ",$S(PSORXST=0:"COPAYMENT ELIGIBLE",PSORXST=1:"COPAYMENT EXEMPT",1:"")
-	W !,"patient status."
-	W "  The copay status for this Rx will be automatically adjusted."
-	W !,"If action needs to be taken to adjust charges you MUST use the"
-	W !,"Reset Copay Status/Cancel Charges option."
-	W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
-	I +$P($G(^PS(53,+$P(^PSRX(DA,0),"^",3),0)),"^",7)=1 D  ; SET TO NO COPAY AND AUDIT CHANGE
-	. I '$D(^PSRX(DA,"IB")) S ^PSRX(DA,"IB")=""
-	. S $P(^PSRX(DA,"IB"),"^",1)=""
-	. S PSODA=DA
-	. S PSOREF=RFD
-	. S PSOCOMM="Rx Patient Status Change"
-	. S PSOOLD="Copay"
-	. S PSONW="No Copay"
-	. S PREA="R"
-	. D ACTLOG^PSOCPA
-COPAYX	K DA,PSODAYS,PSO,PSODA,PSOFLAG,PSORXST,RFD,PSOREF,PSOCOMM,PSOOLD,PSONW
-	Q
-CPCK	;update COPAY
-	I 'RFD,'$D(^PSRX(DA,"PFS")) G CPCK1
-	I RFD,'$D(^PSRX(DA,1,RFD,"PFS")) G CPCK1
-	N PSOPFS S PSOPFS=$P($S('RFD:^PSRX(DA,"PFS"),1:^PSRX(DA,1,RFD,"PFS")),"^",1,2)
-	I +$G(PSOPFS)>0&('$P($G(PSOPFS),"^",2)) K PSOPFS Q
-	I +$G(PSOPFS)<1 K PSOPFS
-	E  S PSOPFS="1^"_PSOPFS
-CPCK1	N TYPE S PSO=2,PSODA=DA,PSOFLAG=1,PSOPAR7=$G(^PS(59,PSOSITE,"IB")),TYPE=RFD D RXED^PSOCPA K TYPE
-	Q
-NEXT	D NEXT^PSOUTIL(.PSORXED) K DIE,DR,DA S DIE="^PSRX(",DA=PSORXED("IRXN")
-	S DR="101///"_$P(PSORXED("RX3"),"^")_";102///"_$P(PSORXED("RX3"),"^",2) D ^DIE K DIE,DR,DA,X,Y
-	Q
-EOJ	K PSOSIG,PSORXED,PSOLIST,END,PSRX0
-	D EX^PSORXED1
-	Q
-FILL	;
-	K PSOEDITF,PSOEDITR,PSOERF
-	F PSOEZ=0:0 S PSOEZ=$O(^PSRX(DA,1,PSOEZ)) Q:'PSOEZ  S:$D(^PSRX(DA,1,PSOEZ,0)) PSOERF=PSOEZ
-	S PSOEDITF=$S($G(PSOERF):+$G(PSOERF),1:0)
-	I PSOEDITF S PSOEDITR=$S($P($G(^PSRX(DA,1,PSOEDITF,0)),"^",18):1,1:0) G FILLX
-	S PSOEDITR=$S($P($G(^PSRX(DA,2)),"^",13):1,1:0)
-FILLX	K PSOERF,PSOEZ
-	Q
-LBL	;
-	S PSOEDITL=0
-	I COM["PROV"!(COM["QTY")!(COM["DAYS")!(COM["MAIL")!(COM["UNIT")!(COM["FILL DATE")!(COM["REMARKS") I COM'["STATUS",COM'["CLINIC",COM'["DRUG",COM'["REFILLS",COM'["ISSUE",COM'["SIG",COM'["TRADE" D  Q
-	.I $G(PSOEDITF) S PSOEDITL=1 Q
-	.I '$G(PSOEDITF),$G(PSOEDITR) S PSOEDITL=2
-	I '$G(PSOEDITF),$G(PSOEDITR) S PSOEDITL=2 Q
-	I '$G(PSOEDITF),'$G(PSOEDITR) S PSOEDITL=0 Q
-	I $G(RXRP(DA)) S PSOEDITL=1 Q
-	I '$G(RXRP(DA)),$G(PSOEDITR) S PSOEDITL=2 Q
-	S PSOEDITL=0
-	Q
-ASKL	;
-	W ! K DIR S DIR("?",1)="You have edited a fill that has already been released. Do you want to",DIR("?",2)="include this prescription as one of the prescriptions to be acted upon",DIR("?",3)="at the label prompt."
-	S DIR("?")="Enter 'Yes' to generate a reprint label request."
-	S DIR(0)="Y",DIR("A")="The last fill has been released, do you want a reprint label",DIR("B")="Y" D ^DIR K DIR I Y=1 S PSOEDITL=0 Q
-	S PSOEDITL=1
-	Q
-SETRP	I $P($G(^PSRX(PSORXED("IRXN"),"STA")),"^")'=5,$G(PSOEDITL)=0 S RXRP(PSORXED("IRXN"))="1^^^1",VALMSG="Label will reprint due to Edit"
-	Q
+PSORXED ;IHS/DSD/JCM-edit rx utility ;02/18/98  3:14 PM
+ ;;7.0;OUTPATIENT PHARMACY;**2,16,21,26,56,71,125,201**;DEC 1997
+ ;External reference to ^PSXEDIT supported by DBIA 2209
+ ;External reference to ^DD(52 supported by DBIA 999
+ ;External reference to ^PSDRUG supported by DBIA 221
+ ;External reference to ^PS(55 supported by DBIA 2228
+START ;this entry point is no longer used.
+ ;D INIT,LKUP G:PSORXED("QFLG") END D PARSE,EOJ G START
+END D EOJ
+ Q
+INIT S PSORXED("QFLG")=0 Q
+LKUP ; this line of code is no longer used S PSONUM="RX",PSONUM("A")="EDIT",PSOQFLG=0 D EN1^PSONUM I PSOQFLG!($Q(PSOLIST)']"") S PSORXED("QFLG")=1
+ K PSOQFLG Q
+ ;
+PARSE F PSORXED("LIST")=1:1 Q:'$D(PSOLIST(PSORXED("LIST")))!PSORXED("QFLG")  F PSORXED("I")=1:1:$L(PSOLIST(PSORXED("LIST"))) S PSORXED("IRXN")=$P(PSOLIST(PSORXED("LIST")),",",PSORXED("I")) D:+PSORXED("IRXN") PROCESS
+ Q
+PROCESS S PSORXED("DFLG")=0 G:$G(^PSRX(PSORXED("IRXN"),0))']"" PROCESSX
+ S PSORXED("RX0")=^PSRX(PSORXED("IRXN"),0),PSORXED("RX2")=^(2),PSORXED("RX3")=^(3),PSOSIG=$G(^PSRX(PSORXED("IRXN"),"SIG")),PSODAYS=$P(PSORXED("RX0"),"^",8)
+ S (I,RFED,RFDT)=0 F  S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I  S RFED=I,PSORXED("RX1")=^PSRX(PSORXED("IRXN"),1,I,0),RFDT=$P(^(0),"^"),PSODAYS=$P(^(0),"^",10) S:$P(^(0),"^",17) PSONEW("PROVIDER NAME")=$P(^VA(200,$P(^(0),"^",17),0),"^")
+ S PSORXST=+$P($G(^PS(53,+$P(PSORXED("RX0"),"^",3),0)),"^",7) N DA S DA=PSORXED("IRXN") D EN^PSORXPR
+ D CHECK G:PSORXED("DFLG") PROCESSX
+ N X S X="PSXEDIT" X ^%ZOSF("TEST") K X I $T D ^PSXEDIT I $G(PSXOUT) K PSXOUT G L1
+ D DIE^PSORXED1
+L1 D LOG,POST
+PROCESSX Q
+CHECK Q  L +^PSRX(PSORXED("IRXN")):0 I '$T W $C(7),!!,"Rx Number is Locked by Another User!",! S PSORXED("DFLG")=1 H 5 Q
+ I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT D  G CHECKX
+ . W !,$C(7),"This drug has been inactivated. ",! S PSORXED("DFLG")=1 Q
+ K PSPOP I $G(PSODIV),$P(PSORXED("RX2"),"^",9)'=PSOSITE S PSPRXN=PSORXED("IRXN") D CHK1^PSOUTLA I $G(PSPOP)=1 S PSORXED("DFLG")=1 G CHECKX
+ ;
+ I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=14!($P(^("STA"),"^")=15) S PSORXED("DFLG")=1 W !!,$C(7),"Discontinued prescriptions cannot be edited.",! G CHECKX
+ I $D(^PS(52.4,"B",PSORXED("IRXN"))) S PSORXED("DFLG")=1 W !!,$C(7),"Non-verified prescriptions cannot be edited.",!
+CHECKX K PSPOP,DIR,DTOUT,DUOUT,Y,X Q
+LOG K PSFROM S DA=PSORXED("IRXN"),(PSRX0,RX0)=PSORXED("RX0"),QTY=$P(RX0,"^",7),QTY=QTY-$P(^PSRX(DA,0),"^",7) K ZD(DA) S:'$O(^PSRX(DA,1,0)) ZD(DA)=$P(^PSRX(DA,2),"^",2)
+ S COM="" F I=3,4,5:1:13,17 I $P(PSRX0,"^",I)'=$P(^PSRX(DA,0),"^",I) S PSI=$S(I=13:1,1:I),COM=COM_$P(^DD(52,PSI,0),"^")_" ("_$P(PSRX0,"^",I)_"),"
+ I $P(PSORXED("RX2"),"^",2)'=$P(^PSRX(DA,2),"^",2) S COM=COM_$P(^DD(52,22,0),"^")_" ("_$P(PSORXED("RX2"),"^",2)_"),"
+ I $P(PSORXED("RX3"),"^",7)'=$P(^PSRX(DA,3),"^",7) S COM=COM_$P(^DD(52,12,0),"^")_" ("_$P(PSORXED("RX3"),"^",7)_"),"
+ I PSOSIG'=$P($G(^PSRX(DA,"SIG")),"^") S COM=COM_$P(^DD(52,10,0),"^")_" ("_PSOSIG_"),"
+ I PSOTRN'=$G(^PSRX(DA,"TN")) S COM=COM_$P(^DD(52,6.5,0),"^")_" ("_PSOTRN_"),"
+ G:COM="" LOGX K PSRX0 S X=$S($D(PSOCLC):PSOCLC,1:DUZ)
+ D FILL,LBL D:$G(PSOEDITL)=2&($P($G(^PSRX(DA,"STA")),"^")'=5)&('$G(RXRP(DA)))&('$G(PSOSIGFL)) ASKL
+ S K=1,D1=0 F Z=0:0 S Z=$O(^PSRX(DA,"A",Z)) Q:'Z  S D1=Z,K=K+1
+ S D1=D1+1 S:'($D(^PSRX(DA,"A",0))#2) ^(0)="^52.3DA^^^" S ^(0)=$P(^(0),"^",1,2)_"^"_D1_"^"_K
+ S ^PSRX(DA,"A",D1,0)=DT_"^E^"_$G(DUZ)_"^0^"_COM
+ I QTY,$P(^PSRX(DA,2),"^",13) S ^PSDRUG($P(^PSRX(DA,0),"^",6),660.1)=$S($D(^PSDRUG(+$P(^PSRX(DA,0),"^",6),660.1)):^(660.1)+QTY,1:QTY)
+ S:$P(RX0,"^",6)'=$P(^PSRX(DA,0),"^",6) ^PSDRUG(+$P(^PSRX(DA,0),"^",6),660.1)=$S($D(^PSDRUG(+$P(RX0,"^",6),660.1)):^(660.1)+$P(RX0,"^",7),1:$P(RX0,"^",7))
+ S RX0=^PSRX(DA,0),RX2=^(2),J=DA,OEXDT=+$P(RX2,"^",6) D ^PSOEXDT S NEXDT=+$P(RX2,"^",6) I OEXDT'=NEXDT D
+ .K ^PSRX("AG",OEXDT,DA) S ^PSRX("AG",NEXDT,DA)=""
+ .S D=+$P(RX0,"^",2) K ^PS(55,D,"P","A",OEXDT,DA) S ^PS(55,D,"P","A",NEXDT,DA)=""
+ K D,OEXDT,NEXDT
+ G:+$P(^PSRX(J,"STA"),"^")!($G(PSOEDITL)=1) LOGX S RXFL(PSORXED("IRXN"))=$S($G(PSOEDITF):$G(PSOEDITF),1:0) I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSORXED("IRXN")_"," D SETRP G LOGX
+ G:$G(PSOEDITL)=1 LOGX
+ F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1  S PSOX2=PSOX1
+ I $L(PSORX("PSOL",PSOX2))+$L(PSORXED("IRXN"))<220 D  G LOGX
+ .I PSORX("PSOL",PSOX2)'[PSORXED("IRXN")_"," S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSORXED("IRXN")_"," D SETRP
+ E  I PSORX("PSOL",PSOX2+1)'[PSORXED("IRXN")_"," S PSORX("PSOL",PSOX2+1)=PSORXED("IRXN")_"," D SETRP
+LOGX K PSOEDITF,PSOEDITR,PSOEDITL D:$G(RFED) ^PSORXED1
+ Q
+POST ; D NEXT D:$G(^PSRX(PSORXED("IRXN"),"IB"))]"" COPAY K PSODAYS,PSORXST
+ D NEXT D COPAY K PSODAYS,PSORXST
+ Q
+COPAY S DA=PSORXED("IRXN") I 'RFD,PSODAYS'=+$P(^PSRX(DA,0),"^",8) I +$G(^PSRX(DA,"IB"))!($P($G(^PSRX(DA,"PFS")),"^",2)) D CPCK G RXST
+ I RFD,+$G(^PSRX(DA,1,RFD,0)),PSODAYS'=$P($G(^PSRX(DA,1,RFD,0)),"^",10) I +$G(^PSRX(DA,"IB"))!($P($G(^PSRX(DA,1,RFD,"PFS")),"^",2)) D CPCK
+RXST G:PSORXST=+$P($G(^PS(53,+$P(^PSRX(DA,0),"^",3),0)),"^",7) COPAYX
+ W !,$C(7),"Patient Status field for this Rx has been changed from a ",$S(PSORXST=0:"COPAYMENT ELIGIBLE",PSORXST=1:"COPAYMENT EXEMPT",1:"")
+ W !,"patient status."
+ W "  The copay status for this Rx will be automatically adjusted."
+ W !,"If action needs to be taken to adjust charges you MUST use the"
+ W !,"Reset Copay Status/Cancel Charges option."
+ W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
+ I +$P($G(^PS(53,+$P(^PSRX(DA,0),"^",3),0)),"^",7)=1 D  ; SET TO NO COPAY AND AUDIT CHANGE
+ . I '$D(^PSRX(DA,"IB")) S ^PSRX(DA,"IB")=""
+ . S $P(^PSRX(DA,"IB"),"^",1)=""
+ . S PSODA=DA
+ . S PSOREF=RFD
+ . S PSOCOMM="Rx Patient Status Change"
+ . S PSOOLD="Copay"
+ . S PSONW="No Copay"
+ . S PREA="R"
+ . D ACTLOG^PSOCPA
+COPAYX K DA,PSODAYS,PSO,PSODA,PSOFLAG,PSORXST,RFD,PSOREF,PSOCOMM,PSOOLD,PSONW
+ Q
+CPCK ;update COPAY
+ I 'RFD,'$D(^PSRX(DA,"PFS")) G CPCK1
+ I RFD,'$D(^PSRX(DA,1,RFD,"PFS")) G CPCK1
+ N PSOPFS S PSOPFS=$P($S('RFD:^PSRX(DA,"PFS"),1:^PSRX(DA,1,RFD,"PFS")),"^",1,2)
+ I +$G(PSOPFS)>0&('$P($G(PSOPFS),"^",2)) K PSOPFS Q
+ I +$G(PSOPFS)<1 K PSOPFS
+ E  S PSOPFS="1^"_PSOPFS
+CPCK1 N TYPE S PSO=2,PSODA=DA,PSOFLAG=1,PSOPAR7=$G(^PS(59,PSOSITE,"IB")),TYPE=RFD D RXED^PSOCPA K TYPE
+ Q
+NEXT D NEXT^PSOUTIL(.PSORXED) K DIE,DR,DA S DIE="^PSRX(",DA=PSORXED("IRXN")
+ S DR="101///"_$P(PSORXED("RX3"),"^")_";102///"_$P(PSORXED("RX3"),"^",2) D ^DIE K DIE,DR,DA,X,Y
+ Q
+EOJ K PSOSIG,PSORXED,PSOLIST,END,PSRX0
+ D EX^PSORXED1
+ Q
+FILL ;
+ K PSOEDITF,PSOEDITR,PSOERF
+ F PSOEZ=0:0 S PSOEZ=$O(^PSRX(DA,1,PSOEZ)) Q:'PSOEZ  S:$D(^PSRX(DA,1,PSOEZ,0)) PSOERF=PSOEZ
+ S PSOEDITF=$S($G(PSOERF):+$G(PSOERF),1:0)
+ I PSOEDITF S PSOEDITR=$S($P($G(^PSRX(DA,1,PSOEDITF,0)),"^",18):1,1:0) G FILLX
+ S PSOEDITR=$S($P($G(^PSRX(DA,2)),"^",13):1,1:0)
+FILLX K PSOERF,PSOEZ
+ Q
+LBL ;
+ S PSOEDITL=0
+ I COM["PROV"!(COM["QTY")!(COM["DAYS")!(COM["MAIL")!(COM["UNIT")!(COM["FILL DATE")!(COM["REMARKS") I COM'["STATUS",COM'["CLINIC",COM'["DRUG",COM'["REFILLS",COM'["ISSUE",COM'["SIG",COM'["TRADE" D  Q
+ .I $G(PSOEDITF) S PSOEDITL=1 Q
+ .I '$G(PSOEDITF),$G(PSOEDITR) S PSOEDITL=2
+ I '$G(PSOEDITF),$G(PSOEDITR) S PSOEDITL=2 Q
+ I '$G(PSOEDITF),'$G(PSOEDITR) S PSOEDITL=0 Q
+ I $G(RXRP(DA)) S PSOEDITL=1 Q
+ I '$G(RXRP(DA)),$G(PSOEDITR) S PSOEDITL=2 Q
+ S PSOEDITL=0
+ Q
+ASKL ;
+ W ! K DIR S DIR("?",1)="You have edited a fill that has already been released. Do you want to",DIR("?",2)="include this prescription as one of the prescriptions to be acted upon",DIR("?",3)="at the label prompt."
+ S DIR("?")="Enter 'Yes' to generate a reprint label request."
+ S DIR(0)="Y",DIR("A")="The last fill has been released, do you want a reprint label",DIR("B")="Y" D ^DIR K DIR I Y=1 S PSOEDITL=0 Q
+ S PSOEDITL=1
+ Q
+SETRP I $P($G(^PSRX(PSORXED("IRXN"),"STA")),"^")'=5,$G(PSOEDITL)=0 S RXRP(PSORXED("IRXN"))="1^^^1",VALMSG="Label will reprint due to Edit"
+ Q
