- 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 Feb 18, 2025@23:26:32 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
