FBAAPHV ;AISC/DMK - PHARMACY PAYMENT VOID ;5/15/14 13:44
;;3.5;FEE BASIS;**69,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;Variable 'FBVOID' is set if cancelling a voided payment.
D DT^DICRW
N FBFPPSC
RD S DIC="^FBAA(162.1,",DIC(0)="AEQM",DIC("A")="Select Invoice number: ",DIC("S")="I $P(^(0),U,5)=4" D ^DIC G Q:X["^"!(X=""),RD:Y<0 S FBAAIN=+Y K DIC("A"),DIC("S")
S FBFPPSC=$P($G(^FBAA(162.1,FBAAIN,0)),U,13)
I FBFPPSC]"" W !,?2,"FPPS Claim ID: ",FBFPPSC
RX W ! S DIC="^FBAA(162.1,FBAAIN,""RX"",",DIC(0)="AEQM",DIC("A")="Select Prescription # : " D ^DIC G Q:X["^"!(X=""),RD:Y<0
S (DA,RX)=+Y,RXN=$P(Y,"^",2) K DIC
I $D(FBVOID),'$D(^FBAA(162.1,FBAAIN,"RX",RX,2)) W !,*7,"Payment not voided!",! K DA G RD
I '$D(FBVOID),$D(^FBAA(162.1,FBAAIN,"RX",RX,2)),$P(^(2),"^",3)="V" W !,*7,"Payment already voided!",! K DA G RD
W !! S DIC="^FBAA(162.1,FBAAIN,""RX"",",DIC(0)="AEQM",DR="" D EN^DIQ
RD1 S DIR(0)="Y",DIR("A")="Is this the prescription you want to "_$S($D(FBVOID):"Cancel the void on ",1:"Void"),DIR("B")="NO",DIR("?")="Answer 'Yes' if you want to "_$S($D(FBVOID):"Cancel the void on ",1:"Void ")_"this prescription."
D ^DIR K DIR G RD:$D(DIRUT),RX:'Y
S V=$S($D(FBVOID):"",1:"VOID"),DR=$S($D(FBVOID):"23///@;23.5///@;24///@",1:"23////^S X=""V"";23.5R;24////^S X=DUZ"),DIE="^FBAA(162.1,FBAAIN,""RX""," D ^DIE
S FBON=$P(^FBAA(162.1,FBAAIN,"RX",DA,0),"^",18),A2=$P(^(0),"^",16),DFN=$P(^(0),"^",5) D ^FBAAVP0 W !,?5,"... Done.",!
Q K DA,DIC,DIE,DIRUT,RX,RXN,X,Y,A2,DFN,DR,FBAACB,FBAAIN,FBON,FBVOID,ON,P3,P4,RX,RXN,V,VAL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPHV 1599 printed Oct 16, 2024@17:56:52 Page 2
FBAAPHV ;AISC/DMK - PHARMACY PAYMENT VOID ;5/15/14 13:44
+1 ;;3.5;FEE BASIS;**69,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;Variable 'FBVOID' is set if cancelling a voided payment.
+4 DO DT^DICRW
+5 NEW FBFPPSC
RD SET DIC="^FBAA(162.1,"
SET DIC(0)="AEQM"
SET DIC("A")="Select Invoice number: "
SET DIC("S")="I $P(^(0),U,5)=4"
DO ^DIC
if X["^"!(X="")
GOTO Q
if Y<0
GOTO RD
SET FBAAIN=+Y
KILL DIC("A"),DIC("S")
+1 SET FBFPPSC=$PIECE($GET(^FBAA(162.1,FBAAIN,0)),U,13)
+2 IF FBFPPSC]""
WRITE !,?2,"FPPS Claim ID: ",FBFPPSC
RX WRITE !
SET DIC="^FBAA(162.1,FBAAIN,""RX"","
SET DIC(0)="AEQM"
SET DIC("A")="Select Prescription # : "
DO ^DIC
if X["^"!(X="")
GOTO Q
if Y<0
GOTO RD
+1 SET (DA,RX)=+Y
SET RXN=$PIECE(Y,"^",2)
KILL DIC
+2 IF $DATA(FBVOID)
IF '$DATA(^FBAA(162.1,FBAAIN,"RX",RX,2))
WRITE !,*7,"Payment not voided!",!
KILL DA
GOTO RD
+3 IF '$DATA(FBVOID)
IF $DATA(^FBAA(162.1,FBAAIN,"RX",RX,2))
IF $PIECE(^(2),"^",3)="V"
WRITE !,*7,"Payment already voided!",!
KILL DA
GOTO RD
+4 WRITE !!
SET DIC="^FBAA(162.1,FBAAIN,""RX"","
SET DIC(0)="AEQM"
SET DR=""
DO EN^DIQ
RD1 SET DIR(0)="Y"
SET DIR("A")="Is this the prescription you want to "_$SELECT($DATA(FBVOID):"Cancel the void on ",1:"Void")
SET DIR("B")="NO"
SET DIR("?")="Answer 'Yes' if you want to "_$SELECT($DATA(FBVOID):"Cancel the void on ",1:"Void ")_"this prescription."
+1 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO RD
if 'Y
GOTO RX
+2 SET V=$SELECT($DATA(FBVOID):"",1:"VOID")
SET DR=$SELECT($DATA(FBVOID):"23///@;23.5///@;24///@",1:"23////^S X=""V"";23.5R;24////^S X=DUZ")
SET DIE="^FBAA(162.1,FBAAIN,""RX"","
DO ^DIE
+3 SET FBON=$PIECE(^FBAA(162.1,FBAAIN,"RX",DA,0),"^",18)
SET A2=$PIECE(^(0),"^",16)
SET DFN=$PIECE(^(0),"^",5)
DO ^FBAAVP0
WRITE !,?5,"... Done.",!
Q KILL DA,DIC,DIE,DIRUT,RX,RXN,X,Y,A2,DFN,DR,FBAACB,FBAAIN,FBON,FBVOID,ON,P3,P4,RX,RXN,V,VAL
QUIT
