FBUCDIS ;AISC/TET - DISPLAY UNAUTHORIZED CLAIM(583) ;4/18/2014
;;3.5;FEE BASIS;**32,151**;JAN 30, 1995;Build 14
;;Per VA Directive 6402, this routine should not be modified.
EN D HOME^%ZIS N FBCRT,FBHIST,FBOUT,FBPG,FBX S FBOUT=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBPG=0
W !! D IEN^FBUCUTL3 G:'FBIEN END ;select claim
; ask if list for just mill-bill (1725) or just non-mill bill claims
S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
D DISP7^FBUCUTL5(FBIX,FBIEN,0,FB1725R) ;set array of claims
D DISPX^FBUCUTL1(0) ;display claims
S FBAR=$G(^TMP("FBAR",$J,"FBAR")) I 'FBAR G END ;W !!,"No data on file." G EN
S FBOUT=0,DIR("??")="^D DISPX^FBUCUTL1(0)",DIR(0)="N^1:"_+FBAR_":0",DIR("A")="Select the claim which you would like to display" D ^DIR K DIR S:$D(DIRUT) FBOUT=1 G END:+$G(FBOUT),EN:'+Y
S FBDA=+$G(^TMP("FBAR",$J,+Y))
;
; conditionally ask if historical audit data should be shown
S FBHIST=$O(^FB583(FBDA,"LOG2",0))
I 'FBHIST D G:$G(FBOUT) END
. W !!,"Note: Historical audit data not available for this claim."
. D CR
I FBHIST D G:$G(FBOUT) END
. S DIR(0)="Y",DIR("A")="Show historical audit data",DIR("B")="NO"
. D ^DIR K DIR S:$D(DIRUT) FBOUT=1 Q:$G(FBOUT) S FBHIST=Y
;
DIS ;display claim
D PAGE
S DA=FBDA,DR="0:LOG",DIQ(0)="C",DIC="^FB583(" D EN^DIQ K DIQ
K FBAR,^TMP("FBAR",$J)
;
HIST ; display historical audit data if requested
I FBHIST D
. I IOSL<($Y+20) D PAGE Q:FBOUT
. S FBX="< HISTORICAL AUDIT DATA (since patch FB*3.5*151) >"
. W !!?(IOM-$L(FBX)/2),FBX,!
. S DIC="^FB583(",DA=FBDA,DR="LOG2" D EN^DIQ
G:FBOUT END
;
PEND ;display incomplete items if information pending
I $$PEND^FBUCUTL(FBDA) D
. I IOSL<($Y+10) D PAGE Q:FBOUT
. S FBX="< PENDING INFORMATION >" W !!?(IOM-$L(FBX)/2),FBX,!
. D DISP8^FBUCUTL5(FBDA),DISPX^FBUCUTL1(0) K FBAR,^TMP("FBAR",$J)
G:FBOUT END
;
PAY ;check if any payments
I $$PAY^FBUCUTL(FBDA,"FB583(") D
. I IOSL<($Y+5) D PAGE Q:FBOUT
. S FBX="< PAYMENTS ON FILE >" W !!?(IOM-$L(FBX)/2),FBX,!
G:FBOUT END
;
LINK ;check for associates
I $$LINK^FBUCLNK1(FBDA,FBIX,1) D
. I IOSL<($Y+10) D PAGE Q:FBOUT
. S FBX="< ASSOCIATED CLAIMS >" W !!?(IOM-$L(FBX)/2),FBX,!
. D DISPX^FBUCUTL1(0)
G:FBOUT END
;
END ;kill and quit
K DA,DR,DFN,DIC,DIRUT,DTOUT,DUOUT,FB,FBAAOUT,FBDA,FBDX,FBI,FBIEN,FBIN,FBIX,FBLISTC,FBVEN,FBVID,J,K,Q,S,VA,VADM,X,Y,ZZ,FBPROC,L,VAERR,FBINODE,FBNODE,FBPRGNAM,FBPROG,FB1725R D KILL^FBPAY
K FBARY,^TMP("FBARY",$J),^TMP("FBAR",$J) Q
PAGE ;write new page
D:FBCRT&(FBPG>0) CR Q:FBOUT
HDR W:FBCRT!(FBPG>0) @IOF S FBPG=FBPG+1
;W !,FBHDR,!?70,"Page: ",FBPG,!,$S(FBIX="AVMS":"Veteran",1:"Vendor"),?34,"Fee Program",?53,"Status",?75,"Code",!,FBDASH
Q
CR ;ask end of page prompt
;OUTPUT: FBOUT is set if time out or up arrow out
W ! S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1
Q
S FBDA=FBDA_";FB583(",FBLISTC=1,FBOUT=0,FBAAOUT="",Q="",$P(Q,"-",80)="-",FB("PD")=0
F FBI=0:0 S FBI=$O(^FBAAI("E",FBDA,FBI)) Q:FBI'>0!(FBAAOUT) S FBNODE=$G(^FBAAI(FBI,0)) I FBNODE]"" S FB("PD")=FB("PD")+$P(FBNODE,U,9) D VET^FBCHDI S FB("DFN")=DFN D EN^FBCHDI Q:$G(FBOUT)
D END G EN
HED W !?25,"ASSOCIATED INVOICES",!,?24,$E(Q,1,21),!
Q
OPT I $O(^FBAAC("AM",FBDA,0)) F II=0:0 S II=$O(^FBAAC("AM",FBDA,FB("DFN"),II)) Q:'II F JJ=0:0 S JJ=$O(^FBAAC("AM",FBDA,FB("DFN"),II,JJ)) Q:'JJ F KK=0:0 S KK=$O(^FBAAC("AM",FBDA,FB("DFN"),II,JJ,KK)) Q:'KK D GETPD
K II,JJ,KK Q
GETPD I $D(^FBAAC(FB("DFN"),1,II,1,JJ,1,KK,0)) S FB("PD")=FB("PD")+$P(^(0),"^",3) Q
;
RETURN ;return address display/edit
N FBCT,FBCRT,FBDIS,FBED,FBI,FBOUT,FBPG,FBSADD,FBX D HOME^%ZIS S FBOUT=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBPG=0 G:'FBCRT END
;display return address
RETDIS D STATADD^FBUCUTL2 ;get station address
D PAGE
S (FBCT,FBI)=0 F S FBI=$O(FBSADD(FBI)) Q:'FBI S FBX=FBSADD(FBI) W !?(IOM-$L(FBX)/2),FBX S FBCT=FBCT+1
;edit return address
W !!! S DIR("A")="Do you wish to edit",DIR("B")="No",DIR(0)="Y" D ^DIR K DIR G END:$D(DIRUT) S FBED=+Y,FBDIS=0
G:'FBED END
S DIE="^FBAA(161.4,",DA=1,DR="35.6;1;2;16;3;4;5" D LOCK^FBUCUTL(DIE,DA) I FBLOCK D ^DIE L -^FBAA(161.4,DA)
K DA,DIE,DR,FBLOCK
W !! S DIR("A")="Do you wish to display return address",DIR("B")="Yes",DIR(0)="Y" D ^DIR K DIR G END:$D(DIRUT) S FBDIS=+Y,FBED=0
G END:'FBDIS G END:FBOUT K FBSADD G RETDIS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCDIS 4327 printed Dec 13, 2024@02:00:06 Page 2
FBUCDIS ;AISC/TET - DISPLAY UNAUTHORIZED CLAIM(583) ;4/18/2014
+1 ;;3.5;FEE BASIS;**32,151**;JAN 30, 1995;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
EN DO HOME^%ZIS
NEW FBCRT,FBHIST,FBOUT,FBPG,FBX
SET FBOUT=0
SET FBCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
SET FBPG=0
+1 ;select claim
WRITE !!
DO IEN^FBUCUTL3
if 'FBIEN
GOTO END
+2 ; ask if list for just mill-bill (1725) or just non-mill bill claims
+3 SET FB1725R=$$ASKMB^FBUCUTL9
IF FB1725R=""
GOTO END
+4 ;set array of claims
DO DISP7^FBUCUTL5(FBIX,FBIEN,0,FB1725R)
+5 ;display claims
DO DISPX^FBUCUTL1(0)
+6 ;W !!,"No data on file." G EN
SET FBAR=$GET(^TMP("FBAR",$JOB,"FBAR"))
IF 'FBAR
GOTO END
+7 SET FBOUT=0
SET DIR("??")="^D DISPX^FBUCUTL1(0)"
SET DIR(0)="N^1:"_+FBAR_":0"
SET DIR("A")="Select the claim which you would like to display"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET FBOUT=1
if +$GET(FBOUT)
GOTO END
if '+Y
GOTO EN
+8 SET FBDA=+$GET(^TMP("FBAR",$JOB,+Y))
+9 ;
+10 ; conditionally ask if historical audit data should be shown
+11 SET FBHIST=$ORDER(^FB583(FBDA,"LOG2",0))
+12 IF 'FBHIST
Begin DoDot:1
+13 WRITE !!,"Note: Historical audit data not available for this claim."
+14 DO CR
End DoDot:1
if $GET(FBOUT)
GOTO END
+15 IF FBHIST
Begin DoDot:1
+16 SET DIR(0)="Y"
SET DIR("A")="Show historical audit data"
SET DIR("B")="NO"
+17 DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET FBOUT=1
if $GET(FBOUT)
QUIT
SET FBHIST=Y
End DoDot:1
if $GET(FBOUT)
GOTO END
+18 ;
DIS ;display claim
+1 DO PAGE
+2 SET DA=FBDA
SET DR="0:LOG"
SET DIQ(0)="C"
SET DIC="^FB583("
DO EN^DIQ
KILL DIQ
+3 KILL FBAR,^TMP("FBAR",$JOB)
+4 ;
HIST ; display historical audit data if requested
+1 IF FBHIST
Begin DoDot:1
+2 IF IOSL<($Y+20)
DO PAGE
if FBOUT
QUIT
+3 SET FBX="< HISTORICAL AUDIT DATA (since patch FB*3.5*151) >"
+4 WRITE !!?(IOM-$LENGTH(FBX)/2),FBX,!
+5 SET DIC="^FB583("
SET DA=FBDA
SET DR="LOG2"
DO EN^DIQ
End DoDot:1
+6 if FBOUT
GOTO END
+7 ;
PEND ;display incomplete items if information pending
+1 IF $$PEND^FBUCUTL(FBDA)
Begin DoDot:1
+2 IF IOSL<($Y+10)
DO PAGE
if FBOUT
QUIT
+3 SET FBX="< PENDING INFORMATION >"
WRITE !!?(IOM-$LENGTH(FBX)/2),FBX,!
+4 DO DISP8^FBUCUTL5(FBDA)
DO DISPX^FBUCUTL1(0)
KILL FBAR,^TMP("FBAR",$JOB)
End DoDot:1
+5 if FBOUT
GOTO END
+6 ;
PAY ;check if any payments
+1 IF $$PAY^FBUCUTL(FBDA,"FB583(")
Begin DoDot:1
+2 IF IOSL<($Y+5)
DO PAGE
if FBOUT
QUIT
+3 SET FBX="< PAYMENTS ON FILE >"
WRITE !!?(IOM-$LENGTH(FBX)/2),FBX,!
End DoDot:1
+4 if FBOUT
GOTO END
+5 ;
LINK ;check for associates
+1 IF $$LINK^FBUCLNK1(FBDA,FBIX,1)
Begin DoDot:1
+2 IF IOSL<($Y+10)
DO PAGE
if FBOUT
QUIT
+3 SET FBX="< ASSOCIATED CLAIMS >"
WRITE !!?(IOM-$LENGTH(FBX)/2),FBX,!
+4 DO DISPX^FBUCUTL1(0)
End DoDot:1
+5 if FBOUT
GOTO END
+6 ;
END ;kill and quit
+1 KILL DA,DR,DFN,DIC,DIRUT,DTOUT,DUOUT,FB,FBAAOUT,FBDA,FBDX,FBI,FBIEN,FBIN,FBIX,FBLISTC,FBVEN,FBVID,J,K,Q,S,VA,VADM,X,Y,ZZ,FBPROC,L,VAERR,FBINODE,FBNODE,FBPRGNAM,FBPROG,FB1725R
DO KILL^FBPAY
+2 KILL FBARY,^TMP("FBARY",$JOB),^TMP("FBAR",$JOB)
QUIT
PAGE ;write new page
+1 if FBCRT&(FBPG>0)
DO CR
if FBOUT
QUIT
HDR if FBCRT!(FBPG>0)
WRITE @IOF
SET FBPG=FBPG+1
+1 ;W !,FBHDR,!?70,"Page: ",FBPG,!,$S(FBIX="AVMS":"Veteran",1:"Vendor"),?34,"Fee Program",?53,"Status",?75,"Code",!,FBDASH
+2 QUIT
CR ;ask end of page prompt
+1 ;OUTPUT: FBOUT is set if time out or up arrow out
+2 WRITE !
SET DIR(0)="E"
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET FBOUT=1
+3 QUIT
+4 SET FBDA=FBDA_";FB583("
SET FBLISTC=1
SET FBOUT=0
SET FBAAOUT=""
SET Q=""
SET $PIECE(Q,"-",80)="-"
SET FB("PD")=0
+5 FOR FBI=0:0
SET FBI=$ORDER(^FBAAI("E",FBDA,FBI))
if FBI'>0!(FBAAOUT)
QUIT
SET FBNODE=$GET(^FBAAI(FBI,0))
IF FBNODE]""
SET FB("PD")=FB("PD")+$PIECE(FBNODE,U,9)
DO VET^FBCHDI
SET FB("DFN")=DFN
DO EN^FBCHDI
if $GET(FBOUT)
QUIT
+6 DO END
GOTO EN
HED WRITE !?25,"ASSOCIATED INVOICES",!,?24,$EXTRACT(Q,1,21),!
+1 QUIT
OPT IF $ORDER(^FBAAC("AM",FBDA,0))
FOR II=0:0
SET II=$ORDER(^FBAAC("AM",FBDA,FB("DFN"),II))
if 'II
QUIT
FOR JJ=0:0
SET JJ=$ORDER(^FBAAC("AM",FBDA,FB("DFN"),II,JJ))
if 'JJ
QUIT
FOR KK=0:0
SET KK=$ORDER(^FBAAC("AM",FBDA,FB("DFN"),II,JJ,KK))
if 'KK
QUIT
DO GETPD
+1 KILL II,JJ,KK
QUIT
GETPD IF $DATA(^FBAAC(FB("DFN"),1,II,1,JJ,1,KK,0))
SET FB("PD")=FB("PD")+$PIECE(^(0),"^",3)
QUIT
+1 ;
RETURN ;return address display/edit
+1 NEW FBCT,FBCRT,FBDIS,FBED,FBI,FBOUT,FBPG,FBSADD,FBX
DO HOME^%ZIS
SET FBOUT=0
SET FBCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
SET FBPG=0
if 'FBCRT
GOTO END
+2 ;display return address
RETDIS ;get station address
DO STATADD^FBUCUTL2
+1 DO PAGE
+2 SET (FBCT,FBI)=0
FOR
SET FBI=$ORDER(FBSADD(FBI))
if 'FBI
QUIT
SET FBX=FBSADD(FBI)
WRITE !?(IOM-$LENGTH(FBX)/2),FBX
SET FBCT=FBCT+1
+3 ;edit return address
+4 WRITE !!!
SET DIR("A")="Do you wish to edit"
SET DIR("B")="No"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET FBED=+Y
SET FBDIS=0
+5 if 'FBED
GOTO END
+6 SET DIE="^FBAA(161.4,"
SET DA=1
SET DR="35.6;1;2;16;3;4;5"
DO LOCK^FBUCUTL(DIE,DA)
IF FBLOCK
DO ^DIE
LOCK -^FBAA(161.4,DA)
+7 KILL DA,DIE,DR,FBLOCK
+8 WRITE !!
SET DIR("A")="Do you wish to display return address"
SET DIR("B")="Yes"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET FBDIS=+Y
SET FBED=0
+9 if 'FBDIS
GOTO END
if FBOUT
GOTO END
KILL FBSADD
GOTO RETDIS
