FBCHREQ2 ;AISC/DMK - RECONSIDER A DENIED NOTIFICATION ;9/19/2014
;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
Q:'$G(DUZ)
;look-up a request that has been previously denied
S DIC("S")="S FBZ=^(0) I $P(FBZ,U,15)=3&($P(FBZ,U,9)=""N""!($P(FBZ,U,12)=""N"")) K FBZ"
D ASKV^FBCHREQ G END:X=""!(X="^") K DIC
;display selected request for reconsideration
Q:'$G(DA) W ! S DR="0:99",DIC="^FBAA(162.2," D EN^DIQ K DIC
;ask if correct selection
S DIR(0)="Y",DIR("A")="Is this the correct request",DIR("B")="Yes" D ^DIR K DIR G FBCHREQ2:'Y
;continue and determine if legal or medical denial, reset fields
S FB=$G(^FBAA(162.2,+FBDA,0)) G END:FB']""
S FB1=$S($P(FB,"^",9)="N":1,$P(FB,"^",12)="N":2,1:"") G FBCHREQ2:'FB1
S DIE="^FBAA(162.2,",DR="[FBCH REOPEN REQUEST]" D ^DIE K DIE,DR G FBCHREQ2:$D(DTOUT)!($D(DUOUT))
D
. N FBX
. S FBX=$$ADDUA^FBUTL9(162.2,DA_",","Reconsider denied CH notification.")
. I 'FBX W !,"Error adding record in User Audit. Please contact IRM."
S FBLENT="",DA=FBDA,DIC="^FBAA(162.2,"
G @$S(FB1=1:"LENT1^FBCHREQ",FB1=2:"MENT1^FBCHREQ",1:"FBCHREQ2")
;kill variables and exit
END K DA,FBDA,FBNAME,FBSSN,FB,FB1,FBDFN,DIC,DIE,ZZ
Q
DISPLAY ;display for a data range those requests that have been reconsidered
;ask date range
D DATE^FBAAUTL Q:FBPOP
S FBBEG=BEGDATE-.1,FBEND=ENDDATE+.9
I '$O(^DIA(162.2,"C",0)) W !?5,*7,"No audit data on file.",! G Q
;check Audit file for entries
S PGM="START^FBCHREQ2",VAR="FBBEG^FBEND^BEGDATE^ENDDATE" D ZIS^FBAAUTL G Q:FBPOP
START ;
U IO I $E(IOST,1,2)="C-" W @IOF
S J=0,QQ="=",$P(QQ,"=",80)="=" D HED
F I=FBBEG:0 S I=$O(^DIA(162.2,"C",I)) Q:'I!(I>FBEND) F S J=$O(^(I,J)) Q:'J S FB(1)=$G(^DIA(162.2,+J,0)),FB=$G(^FBAA(162.2,+FB(1),0)) D:FB]""
.W !,$$NAME($P(FB,"^",4))," -",$$SSN^FBAAUTL($P(FB,"^",4),1)
.W ?50,$$DATX^FBAAUTL($P(FB,"^"))
.W !?5,"Field changed: ",$P(^DD(162.2,+$P(FB(1),"^",3),0),"^")," By: ",$P($G(^VA(200,+$P(FB(1),"^",4),0)),"^")
.W !?10,"Date of Change: ",$$DATX^FBAAUTL($P(FB(1),"^",2))
.I $E(IOST,1,2)="C-",$Y+4>IOSL S DIR(0)="E" D ^DIR S:'Y FBOUT=1 I Y W @IOF D HED
.E I $Y+4>IOSL W @IOF D HED
I '$D(FBOUT),$E(IOST,1,2)="C-" W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
Q W ! K FB,FBOUT,FBBEG,FBEND,I,J,QQ,Y,DUOUT,DIRUT,DTOUT,BEGDATE,ENDDATE
D CLOSE^FBAAUTL Q
NAME(X) ;
;X=DFN returns patient name
I $D(X),X Q $E($P($G(^DPT(X,0)),"^"),1,40)
Q "Unknown"
HED ;
W !?15,"AUDIT on FEE NOTIFICATION ENTITLEMENT CHANGE",!?25,$$DATX^FBAAUTL(BEGDATE)," TO ",$$DATX^FBAAUTL(ENDDATE),!?14,$E(QQ,1,46),!
W !,"PATIENT NAME",?49,"DATE/TIME of NOTIFICATION",!?5,"FIELD CHANGED",?39,"SUPERVISOR",!,QQ,!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHREQ2 2740 printed Oct 16, 2024@17:58:44 Page 2
FBCHREQ2 ;AISC/DMK - RECONSIDER A DENIED NOTIFICATION ;9/19/2014
+1 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 if '$GET(DUZ)
QUIT
+4 ;look-up a request that has been previously denied
+5 SET DIC("S")="S FBZ=^(0) I $P(FBZ,U,15)=3&($P(FBZ,U,9)=""N""!($P(FBZ,U,12)=""N"")) K FBZ"
+6 DO ASKV^FBCHREQ
if X=""!(X="^")
GOTO END
KILL DIC
+7 ;display selected request for reconsideration
+8 if '$GET(DA)
QUIT
WRITE !
SET DR="0:99"
SET DIC="^FBAA(162.2,"
DO EN^DIQ
KILL DIC
+9 ;ask if correct selection
+10 SET DIR(0)="Y"
SET DIR("A")="Is this the correct request"
SET DIR("B")="Yes"
DO ^DIR
KILL DIR
if 'Y
GOTO FBCHREQ2
+11 ;continue and determine if legal or medical denial, reset fields
+12 SET FB=$GET(^FBAA(162.2,+FBDA,0))
if FB']""
GOTO END
+13 SET FB1=$SELECT($PIECE(FB,"^",9)="N":1,$PIECE(FB,"^",12)="N":2,1:"")
if 'FB1
GOTO FBCHREQ2
+14 SET DIE="^FBAA(162.2,"
SET DR="[FBCH REOPEN REQUEST]"
DO ^DIE
KILL DIE,DR
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO FBCHREQ2
+15 Begin DoDot:1
+16 NEW FBX
+17 SET FBX=$$ADDUA^FBUTL9(162.2,DA_",","Reconsider denied CH notification.")
+18 IF 'FBX
WRITE !,"Error adding record in User Audit. Please contact IRM."
End DoDot:1
+19 SET FBLENT=""
SET DA=FBDA
SET DIC="^FBAA(162.2,"
+20 GOTO @$SELECT(FB1=1:"LENT1^FBCHREQ",FB1=2:"MENT1^FBCHREQ",1:"FBCHREQ2")
+21 ;kill variables and exit
END KILL DA,FBDA,FBNAME,FBSSN,FB,FB1,FBDFN,DIC,DIE,ZZ
+1 QUIT
DISPLAY ;display for a data range those requests that have been reconsidered
+1 ;ask date range
+2 DO DATE^FBAAUTL
if FBPOP
QUIT
+3 SET FBBEG=BEGDATE-.1
SET FBEND=ENDDATE+.9
+4 IF '$ORDER(^DIA(162.2,"C",0))
WRITE !?5,*7,"No audit data on file.",!
GOTO Q
+5 ;check Audit file for entries
+6 SET PGM="START^FBCHREQ2"
SET VAR="FBBEG^FBEND^BEGDATE^ENDDATE"
DO ZIS^FBAAUTL
if FBPOP
GOTO Q
START ;
+1 USE IO
IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+2 SET J=0
SET QQ="="
SET $PIECE(QQ,"=",80)="="
DO HED
+3 FOR I=FBBEG:0
SET I=$ORDER(^DIA(162.2,"C",I))
if 'I!(I>FBEND)
QUIT
FOR
SET J=$ORDER(^(I,J))
if 'J
QUIT
SET FB(1)=$GET(^DIA(162.2,+J,0))
SET FB=$GET(^FBAA(162.2,+FB(1),0))
if FB]""
Begin DoDot:1
+4 WRITE !,$$NAME($PIECE(FB,"^",4))," -",$$SSN^FBAAUTL($PIECE(FB,"^",4),1)
+5 WRITE ?50,$$DATX^FBAAUTL($PIECE(FB,"^"))
+6 WRITE !?5,"Field changed: ",$PIECE(^DD(162.2,+$PIECE(FB(1),"^",3),0),"^")," By: ",$PIECE($GET(^VA(200,+$PIECE(FB(1),"^",4),0)),"^")
+7 WRITE !?10,"Date of Change: ",$$DATX^FBAAUTL($PIECE(FB(1),"^",2))
+8 IF $EXTRACT(IOST,1,2)="C-"
IF $Y+4>IOSL
SET DIR(0)="E"
DO ^DIR
if 'Y
SET FBOUT=1
IF Y
WRITE @IOF
DO HED
+9 IF '$TEST
IF $Y+4>IOSL
WRITE @IOF
DO HED
End DoDot:1
+10 IF '$DATA(FBOUT)
IF $EXTRACT(IOST,1,2)="C-"
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
KILL DIR
Q WRITE !
KILL FB,FBOUT,FBBEG,FBEND,I,J,QQ,Y,DUOUT,DIRUT,DTOUT,BEGDATE,ENDDATE
+1 DO CLOSE^FBAAUTL
QUIT
NAME(X) ;
+1 ;X=DFN returns patient name
+2 IF $DATA(X)
IF X
QUIT $EXTRACT($PIECE($GET(^DPT(X,0)),"^"),1,40)
+3 QUIT "Unknown"
HED ;
+1 WRITE !?15,"AUDIT on FEE NOTIFICATION ENTITLEMENT CHANGE",!?25,$$DATX^FBAAUTL(BEGDATE)," TO ",$$DATX^FBAAUTL(ENDDATE),!?14,$EXTRACT(QQ,1,46),!
+2 WRITE !,"PATIENT NAME",?49,"DATE/TIME of NOTIFICATION",!?5,"FIELD CHANGED",?39,"SUPERVISOR",!,QQ,!!
+3 QUIT
