FBAAPP0 ;AISC/GRR-ENTER FEE PHARMACY DETERMINATION CONT ;4/27/2005
;;3.5;FEE BASIS;**61,91,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
HELPI W !!,"Enter Invoice number you wish to make a determination on. Must",!,"be an invoice which is 'Pending Determination' status." G RDIN^FBAAPP
ALRDY W !,*7,"Someone is editing that invoice now!" G RDIN^FBAAPP
;
NO1 ;ASK PHARMACIST TO SPECIFY ADJUSTMENT REASON
N FBX
; prompt for adjustments
S FBX=$$ADJ^FBUTL2($P(FBY(0),U,4),.FBADJ,5,,,,.FBRRMK) Q:FBX=0
; prompt for carcless rarcs
S FBX=$$CLESSR^FBUTL4A(.FBADJ,5,.FBRRMK)
Q
;
GOON ; entry point when prescription was denied by pharmacy
S STAT=3,$P(FBY(0),"^",11)=0,$P(FBY(0),"^",14)=DUZ,$P(FBY(0),"^",15)=DT,$P(FBY(0),"^",9)=3,$P(FBY(0),"^",16)=0
RSET ; entry point when prescription was not denied by pharmacy
S $P(FBY(0),"^",21)=$S(FBAAGP="Yes":"Y",FBAAGP="No":"N",1:"")
S $P(FBY(0),"^",22)=FBAAPR
S ^FBAA(162.1,FBJ,"RX",FBK,0)=FBY(0)
K ^FBAA(162.1,FBJ,"RX","AC",1,FBK) S ^FBAA(162.1,FBJ,"RX","AC",STAT,FBK)="",$P(^FBAA(162.1,FBJ,0),"^",5)=$S($D(^FBAA(162.1,FBJ,"RX","AC",1)):1,$D(^(2)):2,$D(^(3)):3,1:0)
I '$D(^FBAA(162.1,FBJ,"RX","AC",1)) K ^FBAA(162.1,"AC",1,FBJ) S ^FBAA(162.1,"AC",2,FBJ)=""
I $D(FBADJ) D
. D FILEADJ^FBRXFA(FBK_","_FBJ_",",.FBADJ) ; file adjustments
. D FILERR^FBRXFR(FBK_","_FBJ_",",.FBRRMK) ; file remittance remarks
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPP0 1430 printed Dec 13, 2024@01:56:14 Page 2
FBAAPP0 ;AISC/GRR-ENTER FEE PHARMACY DETERMINATION CONT ;4/27/2005
+1 ;;3.5;FEE BASIS;**61,91,158**;JAN 30, 1995;Build 94
+2 ;;Per VA Directive 6402, this routine should not be modified.
HELPI WRITE !!,"Enter Invoice number you wish to make a determination on. Must",!,"be an invoice which is 'Pending Determination' status."
GOTO RDIN^FBAAPP
ALRDY WRITE !,*7,"Someone is editing that invoice now!"
GOTO RDIN^FBAAPP
+1 ;
NO1 ;ASK PHARMACIST TO SPECIFY ADJUSTMENT REASON
+1 NEW FBX
+2 ; prompt for adjustments
+3 SET FBX=$$ADJ^FBUTL2($PIECE(FBY(0),U,4),.FBADJ,5,,,,.FBRRMK)
if FBX=0
QUIT
+4 ; prompt for carcless rarcs
+5 SET FBX=$$CLESSR^FBUTL4A(.FBADJ,5,.FBRRMK)
+6 QUIT
+7 ;
GOON ; entry point when prescription was denied by pharmacy
+1 SET STAT=3
SET $PIECE(FBY(0),"^",11)=0
SET $PIECE(FBY(0),"^",14)=DUZ
SET $PIECE(FBY(0),"^",15)=DT
SET $PIECE(FBY(0),"^",9)=3
SET $PIECE(FBY(0),"^",16)=0
RSET ; entry point when prescription was not denied by pharmacy
+1 SET $PIECE(FBY(0),"^",21)=$SELECT(FBAAGP="Yes":"Y",FBAAGP="No":"N",1:"")
+2 SET $PIECE(FBY(0),"^",22)=FBAAPR
+3 SET ^FBAA(162.1,FBJ,"RX",FBK,0)=FBY(0)
+4 KILL ^FBAA(162.1,FBJ,"RX","AC",1,FBK)
SET ^FBAA(162.1,FBJ,"RX","AC",STAT,FBK)=""
SET $PIECE(^FBAA(162.1,FBJ,0),"^",5)=$SELECT($DATA(^FBAA(162.1,FBJ,"RX","AC",1)):1,$DATA(^(2)):2,$DATA(^(3)):3,1:0)
+5 IF '$DATA(^FBAA(162.1,FBJ,"RX","AC",1))
KILL ^FBAA(162.1,"AC",1,FBJ)
SET ^FBAA(162.1,"AC",2,FBJ)=""
+6 IF $DATA(FBADJ)
Begin DoDot:1
+7 ; file adjustments
DO FILEADJ^FBRXFA(FBK_","_FBJ_",",.FBADJ)
+8 ; file remittance remarks
DO FILERR^FBRXFR(FBK_","_FBJ_",",.FBRRMK)
End DoDot:1
+9 QUIT
