FBAAPP0.m

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 ---FBAAPP0   1430     printed  Apr 09, 2024@21:06:09                                                                                                                                                                                                     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