1 | FBUCMEA ;WOIFO/SAB-UNAUTHORIZED CLAIM MAIN MENU ENTRY ACTION ;12/17/2001
|
---|
2 | ;;3.5;FEE BASIS;**38**;JAN 30, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | N DFN,DIR,FBDA,FBDT,FBEXP,FBFR,FBO,FBOUT,FBPG,FBTO,FBVET,FBX,FBY
|
---|
5 | ;
|
---|
6 | ; gather data
|
---|
7 | N VADM,X,Y
|
---|
8 | K ^TMP("FBEX",$J)
|
---|
9 | S FBTO=$$FMADD^XLFDT(DT,6)
|
---|
10 | F FBO=10,55 D
|
---|
11 | . S FBDT=-(FBTO+.1)
|
---|
12 | . F S FBDT=$O(^FB583("AES",FBO,FBDT)) Q:FBDT']"" D
|
---|
13 | . . S FBDA=0 F S FBDA=$O(^FB583("AES",FBO,FBDT,FBDA)) Q:'FBDA D
|
---|
14 | . . . S FBY=$G(^FB583(FBDA,0))
|
---|
15 | . . . S FBEXP=$P(FBY,U,26)
|
---|
16 | . . . S FBVET=$$VET^FBUCUTL($P(FBY,U,4))
|
---|
17 | . . . S ^TMP("FBEX",$J,FBEXP,FBVET_";"_$P(FBY,U,4),FBDA)=""
|
---|
18 | ;
|
---|
19 | ; display resutls
|
---|
20 | I $D(^TMP("FBEX",$J)) D
|
---|
21 | . S FBPG=0,FBOUT=0 D HD
|
---|
22 | . S FBEXP="" F S FBEXP=$O(^TMP("FBEX",$J,FBEXP)) Q:FBEXP="" D Q:FBOUT
|
---|
23 | . . S FBX="" F S FBX=$O(^TMP("FBEX",$J,FBEXP,FBX)) Q:FBX="" D Q:FBOUT
|
---|
24 | . . . S FBDA=0
|
---|
25 | . . . F S FBDA=$O(^TMP("FBEX",$J,FBEXP,FBX,FBDA)) Q:'FBDA D Q:FBOUT
|
---|
26 | . . . . S FBY=$G(^FB583(FBDA,0))
|
---|
27 | . . . . S DFN=$P(FBY,U,4)
|
---|
28 | . . . . D DEM^VADPT
|
---|
29 | . . . . I $Y+6>IOSL D HD Q:FBOUT
|
---|
30 | . . . . W !,$E($P(FBX,";"),1,20),?22,$P(VADM(2),U,2)
|
---|
31 | . . . . W ?36,$E($$VEN^FBUCUTL($P(FBY,U,3)),1,20)
|
---|
32 | . . . . W ?59,$$FMTE^XLFDT(FBEXP,"2F")
|
---|
33 | . . . . W ?69,$E($$GET1^DIQ(162.7,FBDA_",",24),1,10)
|
---|
34 | . . . . D KVAR^VADPT
|
---|
35 | . I 'FBOUT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBOUT=1 Q
|
---|
36 | ;
|
---|
37 | ; clean up
|
---|
38 | K ^TMP("FBEX",$J)
|
---|
39 | Q
|
---|
40 | ;
|
---|
41 | HD ; header
|
---|
42 | I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBOUT=1 Q
|
---|
43 | I $E(IOST,1,2)="C-"!FBPG W @IOF S $X=0
|
---|
44 | S FBPG=FBPG+1
|
---|
45 | W !,?10,"Unauthorized Claims Expiring on or before "_$$FMTE^XLFDT(FBTO)
|
---|
46 | W !,"Veteran",?22,"SSN",?36,"Vendor",?59,"Expires",?69,"Status"
|
---|
47 | W !,"--------------------",?22,"-----------"
|
---|
48 | W ?36,"--------------------"
|
---|
49 | W ?59,"--------",?69,"----------"
|
---|
50 | Q
|
---|
51 | ;FBUCMEA
|
---|