PSOCPB ;BIR/BaB - pharmacy co-pay application cont'd ;1/30/07 9:08am
;;7.0;OUTPATIENT PHARMACY;**72,71,85,185,143,219,239,201,263,303**;DEC 1997;Build 19
;
;REF/IA
;DIS^SDROUT2/112
;^IBARX/125
;VADPT/10061
;SWSTAT^IBBAPI/4663
COPAY ;
;Called by PSON52,PSORN52...Requires PSOCPAY,PSOBILL,DEA=PSDEA,PSOFLAG
;PSOFLAG=1 NEW, PSOFLAG=0 RENEW
S PSOSAVE=PSOCPAY ; Save original status of PSOCPAY
I '$G(PSOSCP)!('$G(PSOSCA)) D SCP^PSORN52D ;CIDC-must ask sc if flagged for it in enrollment
I $G(PSODRUG("DEA"))["S"!($G(PSODRUG("DEA"))["I")!($G(PSODRUG("DEA"))["N") S PSOCPAY=0
G:+PSOBILL'=2&('$G(PSOSCA)) COPAY2
D FULL^VALM1
I $G(PSOMESOI)=1,$G(PSORXED) W !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",! S PSOMESOI=2
I $G(PSOMESFI)=1 W !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",! S PSOMESFI=2
S DFN=+$G(PSODFN) D DIS^SDROUT2
ASK ;
N PSOUFLAG S PSOUFLAG=0
K PSOCPZ("DFLG"),PSONEW("NEWCOPAY")
W ! K DIR,DTOUT,DIRUT,DUOUT
I $G(PSORX("SC"))="SC"!($G(PSORX("SC"))="NSC")!($G(PSOSCOTH)) D
. W:PSOSCP<50&($G(PSODRUG("DEA"))'["S")&($G(PSODRUG("DEA"))'["I")&($G(PSODRUG("DEA"))'["N") !,"This Rx has been flagged by the provider as: "_$S($G(PSOSCOTH):"NO COPAY",$G(PSORX("SC"))="SC":"NO COPAY",1:"COPAY"),! I $G(PSOSCOTX) S PSOSCOTX=2
S DIR("A")="Was treatment for Service Connected condition",DIR(0)="Y"
S DIR("?")="Enter 'Yes' if this prescription is for a Service Connected condition"
I $G(PSORX("SC"))]""!($G(PSORX(+$G(PSORENW("OIRXN")),"SC"))'="") S DIR("B")=$S($G(PSORX("SC"))="SC":"YES",$G(PSORX("SC"))="NSC":"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"SC"))=1:"YES",$G(PSORX(+$G(PSORENW("OIRXN")),"SC"))=0:"NO",1:"")
I $G(PSONEWFF),$G(PSOFLAG) I $G(PSOANSQD("SC"))=0!($G(PSOANSQD("SC"))=1) S DIR("B")=$S($G(PSOANSQD("SC"))=1:"YES",1:"NO")
I $G(DIR("B"))="YES"!($G(DIR("B"))="NO") S PSOUFLAG=$G(DIR("B"))
I $G(DIR("B"))="" K DIR("B")
D ^DIR
I $G(Y)=1!($G(Y)=0) S PSOANSQ("SC")=$G(Y) I $G(PSONEWFF),$G(PSOFLAG) S PSOANSQD("SC")=$G(Y)
I PSOFLAG I Y["^"!($D(DTOUT))!($D(DUOUT)) S PSOCPZ("DFLG")=1
S:Y=0 Y=2
S PSOANSR=+Y I 'PSOANSR,'PSOFLAG D S $P(PSOCPAY,"^")=$S($G(PSOUFLAG)="NO":1,1:0) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR G COPAY2
.W !!,"This Renewal has been designated as "_$S($G(PSOUFLAG)="YES":"SERVICE CONNECTED",1:"NON-SERVICE CONNECTED.")
.W:PSOSCP<50&($G(PSODRUG("DEA"))'["S")&($G(PSODRUG("DEA"))'["I")&($G(PSODRUG("DEA"))'["N") !,"Please use the 'Reset Copay Status/Cancel Charges' option to make corrections."
.S PSOANSQ("SC")=$S($G(PSOUFLAG)="YES":1,1:0)
I $G(PSOFLAG),$G(PSOCPZ("DFLG")) G EXIT
S:PSOANSR=1 PSOCPAY=0 S:PSOANSR=2 $P(PSOCPAY,"^")=1
COPAY2 ;
N PSOPFS S PSOPFS=$$SWSTAT^IBBAPI()
I +PSOCPAY=1,($P(PSOCPAY,"^",2)=1)!($P(PSOCPAY,"^",2)=2) D
.;set IB node in ^PSRX for copay if xactn type is 1 or 2
.S PSONEW("NEWCOPAY")=$P($G(PSOCPAY),"^",2)_"^^"_$S(+$G(PSOPFS):"",1:$P($G(PSOCPAY),"^",2))
EXIT ;
S PSOCPAY=PSOSAVE ;Restore val of PSOCPAY
K PSOSAVE,PSOANSR,DIR,DUOUT,DIRUT,DTOUT,Y,X
Q
RESET ;RESET COPAY STATUS
K PSOSUMM,PSOPFS,PSOPFSA,PSOLFIL,PSOPFSG
I '$D(PSOPAR) D ^PSOLSET G RESET
W ! S DIC="^PSRX(",DIC(0)="AEQZ" D ^DIC K DIC G:Y<0 EXT S PSODA=+Y
W !,?17,"PATIENT: ",$P($G(^DPT($P(^PSRX(PSODA,0),"^",2),0)),"^")
D ICN^PSODPT($P(^PSRX(PSODA,0),"^",2))
S PSORXN=$P(^PSRX(PSODA,0),"^"),PREA="R"
S PCOPAY=$G(^PSRX(PSODA,"IB"))
W !!,"Rx # ",PSORXN," is a ",$S(+PCOPAY:"Copay",1:"No Copay")," prescription"
S PSOLFIL=$$LF^PSOPFSU1(PSODA) D PFSA^PSOPFSU1(PSODA,PSOLFIL,3) ;PSOCPC def PSOPFSA=1 if OP SC/EI's change.
D EXEMCHK^PSOCPC ; CHECK/CHANGE EXEMPTION FLAGS
S PSOIBQ=$G(^PSRX(PSODA,"IBQ"))
I '$G(^PSRX(PSODA,"IB")),PSOIBQ'["1" D G ASKCAN
. K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to reset the status to COPAY" D ^DIR K DIR
. I Y'=1 Q
. S DIC="^IBE(350.3,",DIC("S")="I $P(^(0),U,3)'=2",DIC(0)="AEQMZ",DIC("A")="Select Reason for Reset : " D ^DIC K DIC I Y'<0 S PSORSN=+Y
. S PREA="R",PSOOLD="No Copay",PSONW="Copay",PSOCOMM="" D ACTLOG^PSOCPA
. S PSI=0,PSOCOMM="Copay status of this Rx has been reset to COPAY." D SETSUMM^PSOCPC
. S $P(^PSRX(PSODA,"IB"),"^")=1 ;Reset flag to COPAY
;
I $G(^PSRX(PSODA,"IB")) D G ASKCAN
. K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to reset the status to NO COPAYMENT" D ^DIR K DIR
. I Y'=1 Q
. S DIC="^IBE(350.3,",DIC("S")="I $P(^(0),U,3)'=2",DIC(0)="AEQMZ",DIC("A")="Select Reason for Reset : " D ^DIC K DIC I Y'<0 S PSORSN=+Y
. S PREA="R",PSOOLD="Copay",PSONW="No Copay",PSOCOMM="" D ACTLOG^PSOCPA
. S PSI=0,PSOCOMM="Copay status of this Rx has been reset to NO COPAY." D SETSUMM^PSOCPC
. S $P(^PSRX(PSODA,"IB"),"^")="" ;Reset flag to NO COPAY
ASKCAN D ASKCAN^PSOCPD
I '$D(PSOSUMM) S PSI=0,PSOCOMM="No action taken" D SETSUMM^PSOCPC
D PRTSUMM
I $P($G(PSOPFS),"^",3)>0&(+$G(PSOPFSA)) D CHRG^PSOPFSU1(PSODA,PSOLFIL,"CG",PSOPFS)
RESETE K PSODA,PSORXN,PSORSN,PSOREF,X,Y,PCOPAY,PREA,PSOCOMM,PSI
G RESET
EXT K PSODA,PSORXN,PSORSN,PSOREF,X,Y,PCOPAY,PREA,PSOCOPAY
Q
BILLED ;Collect IB nums,cancel chrgs,reset flag.
W !!,"**********Charges are on file for this Rx.**********"
Q
BILL2 ;
N PSOPREV ; VAR FOR PREV CANCELLED
S PSOPREV=0
S DIC="^IBE(350.3,",DIC("S")="I $P(^(0),U,3)'=2",DIC(0)="AEQMZ",DIC("A")="Select Reason for Reset or Charge Cancellation : " D ^DIC K DIC G ENDMSG:Y<0 S PSORSN=+Y
S X=PSOPAR7_"^"_+$P(^PSRX(PSODA,0),"^",2)_"^^"_DUZ
S SAVX=X
I $D(PSOCAN) D:'$G(PSOPFS) I +$G(PSOPFS)!($G(PSOPFSG)) D PFS^PSOPFSU1 G BILL2END:'$D(PSOCAN)
. N III S III="" F S III=$O(PSOCAN(III)) Q:III="" I PSOCAN(III)["PFS" S PSOPFSG=1 Q ;PFSS switch off, check for prev cots billing
D POTBILL2
I '$D(PSOCAN) G BILL2END
I $G(CANTYPE) D PREVCAN I $O(X(""))="" Q
I '$G(CANTYPE) S I="" F S I=$O(PSOCAN(I)) Q:I="" S X($P(PSOCAN(I),"^",1))=$P(PSOCAN(I),"^",2)_"^"_PSORSN
D CANCEL^IBARX
I $G(CANTYPE) D MSG
I '$D(Y) Q
I +Y=-1 Q
I $D(Y(PSORXN)),+Y(PSORXN)'=-1 S $P(^PSRX(PSODA,"IB"),"^",2)=+Y(PSORXN) K Y(PSORXN) S PREA="C",PSOREF=0,PSOOLD="",PSONW="" D ACTLOG^PSOCPA I '$G(CANTYPE) D MSG
F PSOREF=0:0 S PSOREF=$O(Y(PSOREF)) Q:PSOREF="" I +Y(PSOREF)'=-1 S ^PSRX(PSODA,1,PSOREF,"IB")=+Y(PSOREF) S PREA="C",PSOOLD="",PSONW="" D ACTLOG^PSOCPA I '$G(CANTYPE) D MSG
BILL2END K X,Y,SAVX,PSOREF,PSOCAN
Q
;
POTBILL2 ;see if any potential charges (entries from file 354.71 -- bills that exceeded cap prev) to be cancelled before cancelling regular charges
N X,I
S X=SAVX
I $T(CANIBAM^IBARX)="" Q
S I="" F S I=$O(PSOCAN(I)) Q:I="" I PSOCAN(I)["^CAP" S X($P(PSOCAN(I),"^",1))=$P(PSOCAN(I),"^",2)_"^"_PSORSN K PSOCAN(I)
I $O(X(""))="" Q
S PSOPREV=1
D CANIBAM^IBARX
I $D(X(PSORXN)) S $P(^PSRX(PSODA,"IB"),"^",4)="" S PREA="C",PSOREF=0,PSOCOMM="Potential charge cancelled",PSOOLD="",PSONW="" D ACTLOG^PSOCPA D POTMSG K X(PSORXN)
F PSOREF=0:0 S PSOREF=$O(X(PSOREF)) Q:PSOREF="" Q:PSOREF>11 S $P(^PSRX(PSODA,1,PSOREF,"IB"),"^",2)="" S PREA="C",PSOCOMM="Potential charge cancelled",PSOOLD="",PSONW="" D ACTLOG^PSOCPA D POTMSG
K PSOREF,PREA,PSOCOMM
Q
REFILL S PSOREF=0
F S PSOREF=$O(^PSRX(PSODA,1,PSOREF)) Q:PSOREF'?1N.N D
. I $D(^PSRX(PSODA,1,PSOREF,"PFS")) S:$P($G(^PSRX(PSODA,1,PSOREF,"PFS")),"^",2) X(PSOREF)="^"_$G(PSORSN) Q
. I $D(^PSRX(PSODA,1,PSOREF,"IB")),+^("IB")>0 S X(PSOREF)=+^PSRX(PSODA,1,PSOREF,"IB")_"^"_$G(PSORSN)
S PSOREF=0 F S PSOREF=$O(^PSRX(PSODA,1,PSOREF)) Q:PSOREF'?1N.N I '$D(X(PSOREF)),+$P($G(^PSRX(PSODA,1,PSOREF,"IB")),"^",2) S XX(PSOREF)=+$P(^PSRX(PSODA,1,PSOREF,"IB"),"^",2)_"^"_$G(PSORSN) ; IF ONLY ENTRY FROM 354.71 SAVE IT
Q
SETCP ;IF NOT COPAY MAKE ELIG CALL/SET FLAG FOR FUTURE
W ! S X=PSOPAR7_"^"_+$P(^PSRX(PSODA,0),"^",2)
D XTYPE^IBARX
I +Y=-1 W !!,"Error in processing Copay eligibility, no action taken." Q
S (ACTYP,BL)="",(PSOBILL,PSOCPAY)=0
CP ;
S ACTYP=$O(Y(ACTYP)) G:'ACTYP CP1
F I=0:0 S BL=$O(Y(ACTYP,BL)) Q:BL="" I BL>0 S PSOBILL=BL,PSOCPAY=ACTYP
G CP
CP1 K ACTYP,BL,I
I (PSOBILL'>0)!(PSOCPAY=0) G INELIG
S $P(^PSRX(PSODA,"IB"),"^")=PSOCPAY
W !,"COPAY status on this Rx has been reset.",!,"*** Future refills will be classified as COPAY."
S PREA="R",PSOOLD="No Copay",PSONW="Copay"
D ACTLOG^PSOCPA
Q
INELIG W !,"This Rx does not meet patient eligibility requirement for Copay.",!,"****** Status unchanged *******"
S Y=-1
Q
ENDMSG K X W !,"Unable to process CHARGE REMOVAL without REASON for Reset."
R !,"ENTER a REASON now? (Y/N) ",X:DTIME Q:'$T
I ($E(X)["?")!("YyNn^"'[$E(X)) W !,"Enter YES to select REASON and RESET STATUS." G ENDMSG
I "Yy"[$E(X) G BILL2
Q
MSG ;
S PSI=0
I $G(CANTYPE) S PSOCOMM="Rx # "_PSORXN_" - All copay charges cancelled" D SETSUMM^PSOCPC K PSOCOMM Q
S PSOCOMM="Rx # "_PSORXN_" - "_$S(PSOREF=0:"Original fill",1:"Refill "_PSOREF)_" copay charge cancelled"
D SETSUMM^PSOCPC
K PSOCOMM
Q
POTMSG ;
S PSI=0
I $G(CANTYPE) Q ; (MESSAGE WILL GET SET LATER)
S PSOCOMM="Rx # "_PSORXN_" - "_$S(PSOREF=0:"Original fill",1:"Refill "_PSOREF)_" potential copay charge cancelled"
D SETSUMM^PSOCPC
K PSOCOMM
Q
MSGNOCAN ;
S PSI=0
S PSOCOMM="Rx # "_PSORXN_" - All copay charges have already been cancelled." D SETSUMM^PSOCPC K PSOCOMM
Q
;
PRTSUMM ; prt sum of actions in reset/cancel
I '$D(PSOSUMM) Q
W !
S PSI=""
F S PSI=$O(PSOSUMM(PSI)) Q:PSI="" W !,PSOSUMM(PSI)
K PSOSUMM
Q
PREVCAN ; PREVIEW CANCELS IF "ALL" IS SELECTED
N I,PSOBILL
S I="" F S I=$O(PSOCAN(I)) Q:I="" D I PSOBILL S X($P(PSOCAN(I),"^",1))=$P(PSOCAN(I),"^",2)_"^"_PSORSN
. S PSOBILL=1 I $T(STATUS^IBARX)'="" I PSOCAN(I)'["CAP" S PSOBILL=$$STATUS^IBARX($P(PSOCAN(I),"^",2)) S:PSOBILL=2 PSOBILL=0 ; PREVIOUSLY CANCELLED
I $O(X(""))="" D
. I PSOPREV D MSG Q
. D MSGNOCAN
Q
;
PSOCPB ;BIR/BaB - pharmacy co-pay application cont'd ;1/30/07 9:08am
+1 ;;7.0;OUTPATIENT PHARMACY;**72,71,85,185,143,219,239,201,263,303**;DEC 1997;Build 19
+2 ;
+3 ;REF/IA
+4 ;DIS^SDROUT2/112
+5 ;^IBARX/125
+6 ;VADPT/10061
+7 ;SWSTAT^IBBAPI/4663
COPAY ;
+1 ;Called by PSON52,PSORN52...Requires PSOCPAY,PSOBILL,DEA=PSDEA,PSOFLAG
+2 ;PSOFLAG=1 NEW, PSOFLAG=0 RENEW
+3 ; Save original status of PSOCPAY
SET PSOSAVE=PSOCPAY
+4 ;CIDC-must ask sc if flagged for it in enrollment
IF '$GET(PSOSCP)!('$GET(PSOSCA))
DO SCP^PSORN52D
+5 IF $GET(PSODRUG("DEA"))["S"!($GET(PSODRUG("DEA"))["I")!($GET(PSODRUG("DEA"))["N")
SET PSOCPAY=0
+6 IF +PSOBILL'=2&('$GET(PSOSCA))
GOTO COPAY2
+7 DO FULL^VALM1
+8 IF $GET(PSOMESOI)=1
IF $GET(PSORXED)
WRITE !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",!
SET PSOMESOI=2
+9 IF $GET(PSOMESFI)=1
WRITE !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",!
SET PSOMESFI=2
+10 SET DFN=+$GET(PSODFN)
DO DIS^SDROUT2
ASK ;
+1 NEW PSOUFLAG
SET PSOUFLAG=0
+2 KILL PSOCPZ("DFLG"),PSONEW("NEWCOPAY")
+3 WRITE !
KILL DIR,DTOUT,DIRUT,DUOUT
+4 IF $GET(PSORX("SC"))="SC"!($GET(PSORX("SC"))="NSC")!($GET(PSOSCOTH))
Begin DoDot:1
+5 IF PSOSCP<50&($GET(PSODRUG("DEA"))'["S")&($GET(PSODRUG("DEA"))'["I")&($GET(PSODRUG("DEA"))'["N")
WRITE !,"This Rx has been flagged by the provider as: "_$SELECT($GET(PSOSCOTH):"NO COPAY",$GET(PSORX("SC"))="SC":"NO COPAY",1:"COPAY"),!
IF $GET(PSOSCOTX)
SET PSOSCOTX=2
End DoDot:1
+6 SET DIR("A")="Was treatment for Service Connected condition"
SET DIR(0)="Y"
+7 SET DIR("?")="Enter 'Yes' if this prescription is for a Service Connected condition"
+8 IF $GET(PSORX("SC"))]""!($GET(PSORX(+$GET(PSORENW("OIRXN")),"SC"))'="")
SET DIR("B")=$SELECT($GET(PSORX("SC"))="SC":"YES",$GET(PSORX("SC"))="NSC":"NO",$GET(PSORX(+$GET(PSORENW("OIRXN")),"SC"))=1:"YES",$GET(PSORX(+$GET(PSORENW("OIRXN")),"SC"))=0:"NO",1:"")
+9 IF $GET(PSONEWFF)
IF $GET(PSOFLAG)
IF $GET(PSOANSQD("SC"))=0!($GET(PSOANSQD("SC"))=1)
SET DIR("B")=$SELECT($GET(PSOANSQD("SC"))=1:"YES",1:"NO")
+10 IF $GET(DIR("B"))="YES"!($GET(DIR("B"))="NO")
SET PSOUFLAG=$GET(DIR("B"))
+11 IF $GET(DIR("B"))=""
KILL DIR("B")
+12 DO ^DIR
+13 IF $GET(Y)=1!($GET(Y)=0)
SET PSOANSQ("SC")=$GET(Y)
IF $GET(PSONEWFF)
IF $GET(PSOFLAG)
SET PSOANSQD("SC")=$GET(Y)
+14 IF PSOFLAG
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
SET PSOCPZ("DFLG")=1
+15 IF Y=0
SET Y=2
+16 SET PSOANSR=+Y
IF 'PSOANSR
IF 'PSOFLAG
Begin DoDot:1
+17 WRITE !!,"This Renewal has been designated as "_$SELECT($GET(PSOUFLAG)="YES":"SERVICE CONNECTED",1:"NON-SERVICE CONNECTED.")
+18 IF PSOSCP<50&($GET(PSODRUG("DEA"))'["S")&($GET(PSODRUG("DEA"))'["I")&($GET(PSODRUG("DEA"))'["N")
WRITE !,"Please use the 'Reset Copay Status/Cancel Charges' option to make corrections."
+19 SET PSOANSQ("SC")=$SELECT($GET(PSOUFLAG)="YES":1,1:0)
End DoDot:1
SET $PIECE(PSOCPAY,"^")=$SELECT($GET(PSOUFLAG)="NO":1,1:0)
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
GOTO COPAY2
+20 IF $GET(PSOFLAG)
IF $GET(PSOCPZ("DFLG"))
GOTO EXIT
+21 IF PSOANSR=1
SET PSOCPAY=0
IF PSOANSR=2
SET $PIECE(PSOCPAY,"^")=1
COPAY2 ;
+1 NEW PSOPFS
SET PSOPFS=$$SWSTAT^IBBAPI()
+2 IF +PSOCPAY=1
IF ($PIECE(PSOCPAY,"^",2)=1)!($PIECE(PSOCPAY,"^",2)=2)
Begin DoDot:1
+3 ;set IB node in ^PSRX for copay if xactn type is 1 or 2
+4 SET PSONEW("NEWCOPAY")=$PIECE($GET(PSOCPAY),"^",2)_"^^"_$SELECT(+$GET(PSOPFS):"",1:$PIECE($GET(PSOCPAY),"^",2))
End DoDot:1
EXIT ;
+1 ;Restore val of PSOCPAY
SET PSOCPAY=PSOSAVE
+2 KILL PSOSAVE,PSOANSR,DIR,DUOUT,DIRUT,DTOUT,Y,X
+3 QUIT
RESET ;RESET COPAY STATUS
+1 KILL PSOSUMM,PSOPFS,PSOPFSA,PSOLFIL,PSOPFSG
+2 IF '$DATA(PSOPAR)
DO ^PSOLSET
GOTO RESET
+3 WRITE !
SET DIC="^PSRX("
SET DIC(0)="AEQZ"
DO ^DIC
KILL DIC
IF Y<0
GOTO EXT
SET PSODA=+Y
+4 WRITE !,?17,"PATIENT: ",$PIECE($GET(^DPT($PIECE(^PSRX(PSODA,0),"^",2),0)),"^")
+5 DO ICN^PSODPT($PIECE(^PSRX(PSODA,0),"^",2))
+6 SET PSORXN=$PIECE(^PSRX(PSODA,0),"^")
SET PREA="R"
+7 SET PCOPAY=$GET(^PSRX(PSODA,"IB"))
+8 WRITE !!,"Rx # ",PSORXN," is a ",$SELECT(+PCOPAY:"Copay",1:"No Copay")," prescription"
+9 ;PSOCPC def PSOPFSA=1 if OP SC/EI's change.
SET PSOLFIL=$$LF^PSOPFSU1(PSODA)
DO PFSA^PSOPFSU1(PSODA,PSOLFIL,3)
+10 ; CHECK/CHANGE EXEMPTION FLAGS
DO EXEMCHK^PSOCPC
+11 SET PSOIBQ=$GET(^PSRX(PSODA,"IBQ"))
+12 IF '$GET(^PSRX(PSODA,"IB"))
IF PSOIBQ'["1"
Begin DoDot:1
+13 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you want to reset the status to COPAY"
DO ^DIR
KILL DIR
+14 IF Y'=1
QUIT
+15 SET DIC="^IBE(350.3,"
SET DIC("S")="I $P(^(0),U,3)'=2"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Reason for Reset : "
DO ^DIC
KILL DIC
IF Y'<0
SET PSORSN=+Y
+16 SET PREA="R"
SET PSOOLD="No Copay"
SET PSONW="Copay"
SET PSOCOMM=""
DO ACTLOG^PSOCPA
+17 SET PSI=0
SET PSOCOMM="Copay status of this Rx has been reset to COPAY."
DO SETSUMM^PSOCPC
+18 ;Reset flag to COPAY
SET $PIECE(^PSRX(PSODA,"IB"),"^")=1
End DoDot:1
GOTO ASKCAN
+19 ;
+20 IF $GET(^PSRX(PSODA,"IB"))
Begin DoDot:1
+21 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you want to reset the status to NO COPAYMENT"
DO ^DIR
KILL DIR
+22 IF Y'=1
QUIT
+23 SET DIC="^IBE(350.3,"
SET DIC("S")="I $P(^(0),U,3)'=2"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Reason for Reset : "
DO ^DIC
KILL DIC
IF Y'<0
SET PSORSN=+Y
+24 SET PREA="R"
SET PSOOLD="Copay"
SET PSONW="No Copay"
SET PSOCOMM=""
DO ACTLOG^PSOCPA
+25 SET PSI=0
SET PSOCOMM="Copay status of this Rx has been reset to NO COPAY."
DO SETSUMM^PSOCPC
+26 ;Reset flag to NO COPAY
SET $PIECE(^PSRX(PSODA,"IB"),"^")=""
End DoDot:1
GOTO ASKCAN
ASKCAN DO ASKCAN^PSOCPD
+1 IF '$DATA(PSOSUMM)
SET PSI=0
SET PSOCOMM="No action taken"
DO SETSUMM^PSOCPC
+2 DO PRTSUMM
+3 IF $PIECE($GET(PSOPFS),"^",3)>0&(+$GET(PSOPFSA))
DO CHRG^PSOPFSU1(PSODA,PSOLFIL,"CG",PSOPFS)
RESETE KILL PSODA,PSORXN,PSORSN,PSOREF,X,Y,PCOPAY,PREA,PSOCOMM,PSI
+1 GOTO RESET
EXT KILL PSODA,PSORXN,PSORSN,PSOREF,X,Y,PCOPAY,PREA,PSOCOPAY
+1 QUIT
BILLED ;Collect IB nums,cancel chrgs,reset flag.
+1 WRITE !!,"**********Charges are on file for this Rx.**********"
+2 QUIT
BILL2 ;
+1 ; VAR FOR PREV CANCELLED
NEW PSOPREV
+2 SET PSOPREV=0
+3 SET DIC="^IBE(350.3,"
SET DIC("S")="I $P(^(0),U,3)'=2"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Reason for Reset or Charge Cancellation : "
DO ^DIC
KILL DIC
IF Y<0
GOTO ENDMSG
SET PSORSN=+Y
+4 SET X=PSOPAR7_"^"_+$PIECE(^PSRX(PSODA,0),"^",2)_"^^"_DUZ
+5 SET SAVX=X
+6 IF $DATA(PSOCAN)
IF '$GET(PSOPFS)
Begin DoDot:1
+7 ;PFSS switch off, check for prev cots billing
NEW III
SET III=""
FOR
SET III=$ORDER(PSOCAN(III))
IF III=""
QUIT
IF PSOCAN(III)["PFS"
SET PSOPFSG=1
QUIT
End DoDot:1
IF +$GET(PSOPFS)!($GET(PSOPFSG))
DO PFS^PSOPFSU1
IF '$DATA(PSOCAN)
GOTO BILL2END
+8 DO POTBILL2
+9 IF '$DATA(PSOCAN)
GOTO BILL2END
+10 IF $GET(CANTYPE)
DO PREVCAN
IF $ORDER(X(""))=""
QUIT
+11 IF '$GET(CANTYPE)
SET I=""
FOR
SET I=$ORDER(PSOCAN(I))
IF I=""
QUIT
SET X($PIECE(PSOCAN(I),"^",1))=$PIECE(PSOCAN(I),"^",2)_"^"_PSORSN
+12 DO CANCEL^IBARX
+13 IF $GET(CANTYPE)
DO MSG
+14 IF '$DATA(Y)
QUIT
+15 IF +Y=-1
QUIT
+16 IF $DATA(Y(PSORXN))
IF +Y(PSORXN)'=-1
SET $PIECE(^PSRX(PSODA,"IB"),"^",2)=+Y(PSORXN)
KILL Y(PSORXN)
SET PREA="C"
SET PSOREF=0
SET PSOOLD=""
SET PSONW=""
DO ACTLOG^PSOCPA
IF '$GET(CANTYPE)
DO MSG
+17 FOR PSOREF=0:0
SET PSOREF=$ORDER(Y(PSOREF))
IF PSOREF=""
QUIT
IF +Y(PSOREF)'=-1
SET ^PSRX(PSODA,1,PSOREF,"IB")=+Y(PSOREF)
SET PREA="C"
SET PSOOLD=""
SET PSONW=""
DO ACTLOG^PSOCPA
IF '$GET(CANTYPE)
DO MSG
BILL2END KILL X,Y,SAVX,PSOREF,PSOCAN
+1 QUIT
+2 ;
POTBILL2 ;see if any potential charges (entries from file 354.71 -- bills that exceeded cap prev) to be cancelled before cancelling regular charges
+1 NEW X,I
+2 SET X=SAVX
+3 IF $TEXT(CANIBAM^IBARX)=""
QUIT
+4 SET I=""
FOR
SET I=$ORDER(PSOCAN(I))
IF I=""
QUIT
IF PSOCAN(I)["^CAP"
SET X($PIECE(PSOCAN(I),"^",1))=$PIECE(PSOCAN(I),"^",2)_"^"_PSORSN
KILL PSOCAN(I)
+5 IF $ORDER(X(""))=""
QUIT
+6 SET PSOPREV=1
+7 DO CANIBAM^IBARX
+8 IF $DATA(X(PSORXN))
SET $PIECE(^PSRX(PSODA,"IB"),"^",4)=""
SET PREA="C"
SET PSOREF=0
SET PSOCOMM="Potential charge cancelled"
SET PSOOLD=""
SET PSONW=""
DO ACTLOG^PSOCPA
DO POTMSG
KILL X(PSORXN)
+9 FOR PSOREF=0:0
SET PSOREF=$ORDER(X(PSOREF))
IF PSOREF=""
QUIT
IF PSOREF>11
QUIT
SET $PIECE(^PSRX(PSODA,1,PSOREF,"IB"),"^",2)=""
SET PREA="C"
SET PSOCOMM="Potential charge cancelled"
SET PSOOLD=""
SET PSONW=""
DO ACTLOG^PSOCPA
DO POTMSG
+10 KILL PSOREF,PREA,PSOCOMM
+11 QUIT
REFILL SET PSOREF=0
+1 FOR
SET PSOREF=$ORDER(^PSRX(PSODA,1,PSOREF))
IF PSOREF'?1N.N
QUIT
Begin DoDot:1
+2 IF $DATA(^PSRX(PSODA,1,PSOREF,"PFS"))
IF $PIECE($GET(^PSRX(PSODA,1,PSOREF,"PFS")),"^",2)
SET X(PSOREF)="^"_$GET(PSORSN)
QUIT
+3 IF $DATA(^PSRX(PSODA,1,PSOREF,"IB"))
IF +^("IB")>0
SET X(PSOREF)=+^PSRX(PSODA,1,PSOREF,"IB")_"^"_$GET(PSORSN)
End DoDot:1
+4 ; IF ONLY ENTRY FROM 354.71 SAVE IT
SET PSOREF=0
FOR
SET PSOREF=$ORDER(^PSRX(PSODA,1,PSOREF))
IF PSOREF'?1N.N
QUIT
IF '$DATA(X(PSOREF))
IF +$PIECE($GET(^PSRX(PSODA,1,PSOREF,"IB")),"^",2)
SET XX(PSOREF)=+$PIECE(^PSRX(PSODA,1,PSOREF,"IB"),"^",2)_"^"_$GET(PSORSN)
+5 QUIT
SETCP ;IF NOT COPAY MAKE ELIG CALL/SET FLAG FOR FUTURE
+1 WRITE !
SET X=PSOPAR7_"^"_+$PIECE(^PSRX(PSODA,0),"^",2)
+2 DO XTYPE^IBARX
+3 IF +Y=-1
WRITE !!,"Error in processing Copay eligibility, no action taken."
QUIT
+4 SET (ACTYP,BL)=""
SET (PSOBILL,PSOCPAY)=0
CP ;
+1 SET ACTYP=$ORDER(Y(ACTYP))
IF 'ACTYP
GOTO CP1
+2 FOR I=0:0
SET BL=$ORDER(Y(ACTYP,BL))
IF BL=""
QUIT
IF BL>0
SET PSOBILL=BL
SET PSOCPAY=ACTYP
+3 GOTO CP
CP1 KILL ACTYP,BL,I
+1 IF (PSOBILL'>0)!(PSOCPAY=0)
GOTO INELIG
+2 SET $PIECE(^PSRX(PSODA,"IB"),"^")=PSOCPAY
+3 WRITE !,"COPAY status on this Rx has been reset.",!,"*** Future refills will be classified as COPAY."
+4 SET PREA="R"
SET PSOOLD="No Copay"
SET PSONW="Copay"
+5 DO ACTLOG^PSOCPA
+6 QUIT
INELIG WRITE !,"This Rx does not meet patient eligibility requirement for Copay.",!,"****** Status unchanged *******"
+1 SET Y=-1
+2 QUIT
ENDMSG KILL X
WRITE !,"Unable to process CHARGE REMOVAL without REASON for Reset."
+1 READ !,"ENTER a REASON now? (Y/N) ",X:DTIME
IF '$TEST
QUIT
+2 IF ($EXTRACT(X)["?")!("YyNn^"'[$EXTRACT(X))
WRITE !,"Enter YES to select REASON and RESET STATUS."
GOTO ENDMSG
+3 IF "Yy"[$EXTRACT(X)
GOTO BILL2
+4 QUIT
MSG ;
+1 SET PSI=0
+2 IF $GET(CANTYPE)
SET PSOCOMM="Rx # "_PSORXN_" - All copay charges cancelled"
DO SETSUMM^PSOCPC
KILL PSOCOMM
QUIT
+3 SET PSOCOMM="Rx # "_PSORXN_" - "_$SELECT(PSOREF=0:"Original fill",1:"Refill "_PSOREF)_" copay charge cancelled"
+4 DO SETSUMM^PSOCPC
+5 KILL PSOCOMM
+6 QUIT
POTMSG ;
+1 SET PSI=0
+2 ; (MESSAGE WILL GET SET LATER)
IF $GET(CANTYPE)
QUIT
+3 SET PSOCOMM="Rx # "_PSORXN_" - "_$SELECT(PSOREF=0:"Original fill",1:"Refill "_PSOREF)_" potential copay charge cancelled"
+4 DO SETSUMM^PSOCPC
+5 KILL PSOCOMM
+6 QUIT
MSGNOCAN ;
+1 SET PSI=0
+2 SET PSOCOMM="Rx # "_PSORXN_" - All copay charges have already been cancelled."
DO SETSUMM^PSOCPC
KILL PSOCOMM
+3 QUIT
+4 ;
PRTSUMM ; prt sum of actions in reset/cancel
+1 IF '$DATA(PSOSUMM)
QUIT
+2 WRITE !
+3 SET PSI=""
+4 FOR
SET PSI=$ORDER(PSOSUMM(PSI))
IF PSI=""
QUIT
WRITE !,PSOSUMM(PSI)
+5 KILL PSOSUMM
+6 QUIT
PREVCAN ; PREVIEW CANCELS IF "ALL" IS SELECTED
+1 NEW I,PSOBILL
+2 SET I=""
FOR
SET I=$ORDER(PSOCAN(I))
IF I=""
QUIT
Begin DoDot:1
+3 ; PREVIOUSLY CANCELLED
SET PSOBILL=1
IF $TEXT(STATUS^IBARX)'=""
IF PSOCAN(I)'["CAP"
SET PSOBILL=$$STATUS^IBARX($PIECE(PSOCAN(I),"^",2))
IF PSOBILL=2
SET PSOBILL=0
End DoDot:1
IF PSOBILL
SET X($PIECE(PSOCAN(I),"^",1))=$PIECE(PSOCAN(I),"^",2)_"^"_PSORSN
+4 IF $ORDER(X(""))=""
Begin DoDot:1
+5 IF PSOPREV
DO MSG
QUIT
+6 DO MSGNOCAN
End DoDot:1
+7 QUIT
+8 ;
