source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCMEA.m@ 767

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1FBUCMEA ;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 ;
41HD ; 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
Note: See TracBrowser for help on using the repository browser.