1 | FBAAPHV ;AISC/DMK-PHARMACY PAYMENT VOID ;12JUL88
|
---|
2 | ;;3.5;FEE BASIS;**69**;JAN 30, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;Variable 'FBVOID' is set if cancelling a voided payment.
|
---|
5 | D DT^DICRW
|
---|
6 | N FBFPPSC
|
---|
7 | I '$D(^XUSEC("FBAASUPERVISOR",DUZ)) W !!,*7,"You must be a Fee supervisor to use this option.",! Q
|
---|
8 | 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")
|
---|
9 | S FBFPPSC=$P($G(^FBAA(162.1,FBAAIN,0)),U,13)
|
---|
10 | I FBFPPSC]"" W !,?2,"FPPS Claim ID: ",FBFPPSC
|
---|
11 | 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
|
---|
12 | S (DA,RX)=+Y,RXN=$P(Y,"^",2) K DIC
|
---|
13 | I $D(FBVOID),'$D(^FBAA(162.1,FBAAIN,"RX",RX,2)) W !,*7,"Payment not voided!",! K DA G RD
|
---|
14 | I '$D(FBVOID),$D(^FBAA(162.1,FBAAIN,"RX",RX,2)),$P(^(2),"^",3)="V" W !,*7,"Payment already voided!",! K DA G RD
|
---|
15 | W !! S DIC="^FBAA(162.1,FBAAIN,""RX"",",DIC(0)="AEQM",DR="" D EN^DIQ
|
---|
16 | 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."
|
---|
17 | D ^DIR K DIR G RD:$D(DIRUT),RX:'Y
|
---|
18 | 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
|
---|
19 | S FBON=$P(^FBAA(162.1,FBAAIN,"RX",DA,0),"^",18),A2=$P(^(0),"^",16),DFN=$P(^(0),"^",5) D ^FBAAVP0 W !,?5,"... Done.",!
|
---|
20 | 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
|
---|