Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBCHREQ2

FBCHREQ2.m

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