source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCHREQ2.m@ 895

Last change on this file since 895 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1FBCHREQ2 ;AISC/DMK-RECONSIDER A DENIED NOTIFICATION ;4/28/93 11:01
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;check if user holds 'FBAASUPERVISOR' key
5 Q:'$G(DUZ)
6 I '$D(^XUSEC("FBAASUPERVISOR",DUZ)) W !,*7,"You must be a holder of the 'FBAASUPERVIVOR' key to reconsider a denied request.",! Q
7 ;look-up a request that has been previously denied
8 S DIC("S")="S FBZ=^(0) I $P(FBZ,U,15)=3&($P(FBZ,U,9)=""N""!($P(FBZ,U,12)=""N"")) K FBZ"
9 D ASKV^FBCHREQ G END:X=""!(X="^") K DIC
10 ;display selected request for reconsideration
11 Q:'$G(DA) W ! S DR="0:99",DIC="^FBAA(162.2," D EN^DIQ K DIC
12 ;ask if correct selection
13 S DIR(0)="Y",DIR("A")="Is this the correct request",DIR("B")="Yes" D ^DIR K DIR G FBCHREQ2:'Y
14 ;continue and determine if legal or medical denial, reset fields
15 S FB=$G(^FBAA(162.2,+FBDA,0)) G END:FB']""
16 S FB1=$S($P(FB,"^",9)="N":1,$P(FB,"^",12)="N":2,1:"") G FBCHREQ2:'FB1
17 S DIE="^FBAA(162.2,",DR="[FBCH REOPEN REQUEST]" D ^DIE K DIE,DR G FBCHREQ2:$D(DTOUT)!($D(DUOUT))
18 S FBLENT="",DA=FBDA,DIC="^FBAA(162.2,"
19 G @$S(FB1=1:"LENT1^FBCHREQ",FB1=2:"MENT1^FBCHREQ",1:"FBCHREQ2")
20 ;kill variables and exit
21END K DA,FBDA,FBNAME,FBSSN,FB,FB1,FBDFN,DIC,DIE,ZZ
22 Q
23DISPLAY ;display for a data range those requests that have been reconsidered
24 ;ask date range
25 D DATE^FBAAUTL Q:FBPOP
26 S FBBEG=BEGDATE-.1,FBEND=ENDDATE+.9
27 I '$O(^DIA(162.2,"C",0)) W !?5,*7,"No audit data on file.",! G Q
28 ;check Audit file for entries
29 S PGM="START^FBCHREQ2",VAR="FBBEG^FBEND^BEGDATE^ENDDATE" D ZIS^FBAAUTL G Q:FBPOP
30START ;
31 U IO I $E(IOST,1,2)="C-" W @IOF
32 S J=0,QQ="=",$P(QQ,"=",80)="=" D HED
33 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]""
34 .W !,$$NAME($P(FB,"^",4))," -",$$SSN^FBAAUTL($P(FB,"^",4),1)
35 .W ?50,$$DATX^FBAAUTL($P(FB,"^"))
36 .W !?5,"Field changed: ",$P(^DD(162.2,+$P(FB(1),"^",3),0),"^")," By: ",$P($G(^VA(200,+$P(FB(1),"^",4),0)),"^")
37 .W !?10,"Date of Change: ",$$DATX^FBAAUTL($P(FB(1),"^",2))
38 .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
39 .E I $Y+4>IOSL W @IOF D HED
40 I '$D(FBOUT),$E(IOST,1,2)="C-" W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
41Q W ! K FB,FBOUT,FBBEG,FBEND,I,J,QQ,Y,DUOUT,DIRUT,DTOUT,BEGDATE,ENDDATE
42 D CLOSE^FBAAUTL Q
43NAME(X) ;
44 ;X=DFN returns patient name
45 I $D(X),X Q $E($P($G(^DPT(X,0)),"^"),1,40)
46 Q "Unknown"
47HED ;
48 W !?15,"AUDIT on FEE NOTIFICATION ENTITLEMENT CHANGE",!?25,$$DATX^FBAAUTL(BEGDATE)," TO ",$$DATX^FBAAUTL(ENDDATE),!?14,$E(QQ,1,46),!
49 W !,"PATIENT NAME",?49,"DATE/TIME of NOTIFICATION",!?5,"FIELD CHANGED",?39,"SUPERVISOR",!,QQ,!!
50 Q
Note: See TracBrowser for help on using the repository browser.