VistA-WorldVistAEHR/r/FEE_BASIS-FB/FBAAPHV.m

21 lines
1.6 KiB
Mathematica
Raw Permalink Normal View History

2009-11-29 13:37:14 -05:00
FBAAPHV ;AISC/DMK-PHARMACY PAYMENT VOID ;12JUL88
;;3.5;FEE BASIS;**69**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;Variable 'FBVOID' is set if cancelling a voided payment.
D DT^DICRW
N FBFPPSC
I '$D(^XUSEC("FBAASUPERVISOR",DUZ)) W !!,*7,"You must be a Fee supervisor to use this option.",! Q
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