- 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 Jan 18, 2025@02:59:07 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