source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBUCEX.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1FBUCEX ;ALBISC/TET - EXPIRATION UPDATE &/OR OUTPUT ;7/23/01
2 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4ABAND ;background update to abandoned if expiration date is met
5 ;on claims with status order of 10 or 55
6 N FBDT,FBACT S FBACT="EDT"
7 S FBO=0 F S FBO=$O(^FB583("AES",FBO)) Q:'FBO I "^10^55^"[FBO S FBDT=-(DT) F S FBDT=$O(^FB583("AES",FBO,FBDT)) Q:FBDT']"" S FBDA=0 F S FBDA=$O(^FB583("AES",FBO,FBDT,FBDA)) Q:'FBDA S FBZ=$G(^FB583(FBDA,0)) I FBZ]"" D
8 .N FBUCA,FBUCAA,FBUCP,FBUCPA
9 .D PRIOR^FBUCEVT(FBDA,"EDT") S DIE="^FB583(",DA=FBDA,DR="26///^S X=""@"";10////^S X=5"
10 .D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(DA) K DIE,DR,DA
11 .D AFTER^FBUCEVT(FBDA,"EDT"),^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,"EDT")
12 .S ^TMP("FBEX",$J,$$VET^FBUCUTL($P(FBZ,U,4))_";"_$P(FBZ,U,4),FBDA)=$E($$VEN^FBUCUTL($P(FBZ,U,3)),1,20)_U_$E($P($$PTR^FBUCUTL("^FB(162.92,",$$STATUS^FBUCUTL(FBO)),U),1,16)_U_$$DATX^FBAAUTL($P(FBZ,U,5))_U_$$DATX^FBAAUTL($P(FBZ,U,6))
13 .K FBLOCK
14 G:'$D(^TMP("FBEX")) END S FBHDR="Unauthorized Claims Dispositioned to 'ABANDONED'"
15PRINT ;print claims which have been dispositioned to abandoned or fall within date range to expire
16 U IO S FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBOUT=0,$P(FBDASH,"=",80)="" D PAGE
17 S FBVET="" F S FBVET=$O(^TMP("FBEX",$J,FBVET)) Q:FBVET']""!(FBOUT) S FBDA=0 F S FBDA=$O(^TMP("FBEX",$J,FBVET,FBDA)) Q:'FBDA!(FBOUT) S FBNODE=$G(^TMP("FBEX",$J,FBVET,FBDA)) D Q:FBOUT
18 .I IOSL<($Y+5) D PAGE Q:FBOUT
19 .W !,$E($P(FBVET,";"),1,20),?24,$P(FBNODE,U),?48,$P(FBNODE,U,3),?60,$P(FBNODE,U,4),?72,$E($P(FBNODE,U,2),1,8)
20END ;kill variables,tmp global and quit
21 K FBCRT,FBDA,FBDASH,FBDT,FBFR,FBHDR,FBLOCK,FBNODE,FBO,FBOUT,FBPG,FBPOP,FBTO,FBVET,FBZ,BEGDATE,DIR,DIRUT,DTOUT,DUOUT,ENDDATE,PGM,POP,VAL,VAR,^TMP("FBEX",$J),FB1725R
22 D CLOSE^FBAAUTL
23 Q
24PAGE ;write new page
25 D:FBCRT&(FBPG>0) CR Q:FBOUT
26HDR W:FBCRT!(FBPG>0) @IOF S FBPG=FBPG+1
27 W !,FBHDR,!!,?48,"Treatment",?60,"Treatment",!,"Veteran",?24,"Vendor",?51,"FROM",?64,"TO",?72,"Status",!,FBDASH
28 Q
29CR ;ask end of page prompt
30 ;OUTPUT: FBOUT is set if time out or up arrow out
31 W ! S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1
32 Q
33EXPIRE ;called from print option to display/print claims due to expire within date range
34 ;claim will print if expiration date falls within date range user selected,
35 ;status order is 10 <incomplete> or 55 <appeal/stmt of case issued>,
36 ;and has not been abandoned (ck needed?)
37 ; ask if report for just mill-bill (1725) or just non-mill bill claims
38 S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
39 W !?3,"Select the date range within which an unauthorized claim will expire." S %DT="AEX" D DATE^FBAAUTL K %DT G:FBPOP END
40 S VAR="BEGDATE^ENDDATE^FB1725R",VAL=VAR,PGM="DQ^FBUCEX" D ZIS^FBAAUTL G:FBPOP END
41DQ S FBFR=BEGDATE,FBTO=ENDDATE ;scratch
42 S FBHDR="Unauthorized"_$S(FB1725R="M":" Mill Bill (1725)",FB1725R="N":" NON-Mill Bill",1:"")_" Claims Due to Expire between "_$$DATX^FBAAUTL(FBFR)_" and "_$$DATX^FBAAUTL(FBTO)
43 S FBO=0 F S FBO=$O(^FB583("AES",FBO)) Q:'FBO I "^10^55^"[FBO S FBDT=-(FBTO-.1) F S FBDT=$O(^FB583("AES",FBO,FBDT)) Q:FBDT']""!(FBDT>-FBFR) S FBDA=0 F S FBDA=$O(^FB583("AES",FBO,FBDT,FBDA)) Q:'FBDA S FBZ=$G(^FB583(FBDA,0)) I FBZ]"" D
44 .; if user requested just mill-bill (1725) or non-mill bill claims then
45 .; check claim and skip when appropriate
46 .Q:$S(FB1725R="M"&'+$P(FBZ,U,28):1,FB1725R="N"&+$P(FBZ,U,28):1,1:0)
47 .S ^TMP("FBEX",$J,$$VET^FBUCUTL($P(FBZ,U,4))_";"_$P(FBZ,U,4),FBDA)=$E($$VEN^FBUCUTL($P(FBZ,U,3)),1,20)_U_$E($P($$PTR^FBUCUTL("^FB(162.92,",$$STATUS^FBUCUTL(FBO)),U),1,16)_U_$$DATX^FBAAUTL($P(FBZ,U,5))_U_$$DATX^FBAAUTL($P(FBZ,U,6))
48 I '$D(^TMP("FBEX")) D G END
49 .S FBPG=0,$P(FBDASH,"=",80)="",FBCRT=$S($E(IOST,1,2)="C-":1,1:0)
50 .S FBOUT=0
51 .U IO
52 .D PAGE W !,"No claims will expire within selected date range."
53 G PRINT
54 Q
Note: See TracBrowser for help on using the repository browser.