FBUCMEA ;WOIFO/SAB-UNAUTHORIZED CLAIM MAIN MENU ENTRY ACTION ;12/17/2001
;;3.5;FEE BASIS;**38**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
N DFN,DIR,FBDA,FBDT,FBEXP,FBFR,FBO,FBOUT,FBPG,FBTO,FBVET,FBX,FBY
;
; gather data
N VADM,X,Y
K ^TMP("FBEX",$J)
S FBTO=$$FMADD^XLFDT(DT,6)
F FBO=10,55 D
. S FBDT=-(FBTO+.1)
. F S FBDT=$O(^FB583("AES",FBO,FBDT)) Q:FBDT']"" D
. . S FBDA=0 F S FBDA=$O(^FB583("AES",FBO,FBDT,FBDA)) Q:'FBDA D
. . . S FBY=$G(^FB583(FBDA,0))
. . . S FBEXP=$P(FBY,U,26)
. . . S FBVET=$$VET^FBUCUTL($P(FBY,U,4))
. . . S ^TMP("FBEX",$J,FBEXP,FBVET_";"_$P(FBY,U,4),FBDA)=""
;
; display resutls
I $D(^TMP("FBEX",$J)) D
. S FBPG=0,FBOUT=0 D HD
. S FBEXP="" F S FBEXP=$O(^TMP("FBEX",$J,FBEXP)) Q:FBEXP="" D Q:FBOUT
. . S FBX="" F S FBX=$O(^TMP("FBEX",$J,FBEXP,FBX)) Q:FBX="" D Q:FBOUT
. . . S FBDA=0
. . . F S FBDA=$O(^TMP("FBEX",$J,FBEXP,FBX,FBDA)) Q:'FBDA D Q:FBOUT
. . . . S FBY=$G(^FB583(FBDA,0))
. . . . S DFN=$P(FBY,U,4)
. . . . D DEM^VADPT
. . . . I $Y+6>IOSL D HD Q:FBOUT
. . . . W !,$E($P(FBX,";"),1,20),?22,$P(VADM(2),U,2)
. . . . W ?36,$E($$VEN^FBUCUTL($P(FBY,U,3)),1,20)
. . . . W ?59,$$FMTE^XLFDT(FBEXP,"2F")
. . . . W ?69,$E($$GET1^DIQ(162.7,FBDA_",",24),1,10)
. . . . D KVAR^VADPT
. I 'FBOUT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBOUT=1 Q
;
; clean up
K ^TMP("FBEX",$J)
Q
;
HD ; header
I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBOUT=1 Q
I $E(IOST,1,2)="C-"!FBPG W @IOF S $X=0
S FBPG=FBPG+1
W !,?10,"Unauthorized Claims Expiring on or before "_$$FMTE^XLFDT(FBTO)
W !,"Veteran",?22,"SSN",?36,"Vendor",?59,"Expires",?69,"Status"
W !,"--------------------",?22,"-----------"
W ?36,"--------------------"
W ?59,"--------",?69,"----------"
Q
;FBUCMEA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCMEA 1849 printed Dec 13, 2024@02:00:22 Page 2
FBUCMEA ;WOIFO/SAB-UNAUTHORIZED CLAIM MAIN MENU ENTRY ACTION ;12/17/2001
+1 ;;3.5;FEE BASIS;**38**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 NEW DFN,DIR,FBDA,FBDT,FBEXP,FBFR,FBO,FBOUT,FBPG,FBTO,FBVET,FBX,FBY
+4 ;
+5 ; gather data
+6 NEW VADM,X,Y
+7 KILL ^TMP("FBEX",$JOB)
+8 SET FBTO=$$FMADD^XLFDT(DT,6)
+9 FOR FBO=10,55
Begin DoDot:1
+10 SET FBDT=-(FBTO+.1)
+11 FOR
SET FBDT=$ORDER(^FB583("AES",FBO,FBDT))
if FBDT']""
QUIT
Begin DoDot:2
+12 SET FBDA=0
FOR
SET FBDA=$ORDER(^FB583("AES",FBO,FBDT,FBDA))
if 'FBDA
QUIT
Begin DoDot:3
+13 SET FBY=$GET(^FB583(FBDA,0))
+14 SET FBEXP=$PIECE(FBY,U,26)
+15 SET FBVET=$$VET^FBUCUTL($PIECE(FBY,U,4))
+16 SET ^TMP("FBEX",$JOB,FBEXP,FBVET_";"_$PIECE(FBY,U,4),FBDA)=""
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 ; display resutls
+19 IF $DATA(^TMP("FBEX",$JOB))
Begin DoDot:1
+20 SET FBPG=0
SET FBOUT=0
DO HD
+21 SET FBEXP=""
FOR
SET FBEXP=$ORDER(^TMP("FBEX",$JOB,FBEXP))
if FBEXP=""
QUIT
Begin DoDot:2
+22 SET FBX=""
FOR
SET FBX=$ORDER(^TMP("FBEX",$JOB,FBEXP,FBX))
if FBX=""
QUIT
Begin DoDot:3
+23 SET FBDA=0
+24 FOR
SET FBDA=$ORDER(^TMP("FBEX",$JOB,FBEXP,FBX,FBDA))
if 'FBDA
QUIT
Begin DoDot:4
+25 SET FBY=$GET(^FB583(FBDA,0))
+26 SET DFN=$PIECE(FBY,U,4)
+27 DO DEM^VADPT
+28 IF $Y+6>IOSL
DO HD
if FBOUT
QUIT
+29 WRITE !,$EXTRACT($PIECE(FBX,";"),1,20),?22,$PIECE(VADM(2),U,2)
+30 WRITE ?36,$EXTRACT($$VEN^FBUCUTL($PIECE(FBY,U,3)),1,20)
+31 WRITE ?59,$$FMTE^XLFDT(FBEXP,"2F")
+32 WRITE ?69,$EXTRACT($$GET1^DIQ(162.7,FBDA_",",24),1,10)
+33 DO KVAR^VADPT
End DoDot:4
if FBOUT
QUIT
End DoDot:3
if FBOUT
QUIT
End DoDot:2
if FBOUT
QUIT
+34 IF 'FBOUT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBOUT=1
QUIT
End DoDot:1
+35 ;
+36 ; clean up
+37 KILL ^TMP("FBEX",$JOB)
+38 QUIT
+39 ;
HD ; header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF FBPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBOUT=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!FBPG
WRITE @IOF
SET $X=0
+3 SET FBPG=FBPG+1
+4 WRITE !,?10,"Unauthorized Claims Expiring on or before "_$$FMTE^XLFDT(FBTO)
+5 WRITE !,"Veteran",?22,"SSN",?36,"Vendor",?59,"Expires",?69,"Status"
+6 WRITE !,"--------------------",?22,"-----------"
+7 WRITE ?36,"--------------------"
+8 WRITE ?59,"--------",?69,"----------"
+9 QUIT
+10 ;FBUCMEA
