[613] | 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
|
---|