source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCDIS.m@ 686

FBUCDIS ;AISC/TET-DISPLAY UNAUTHORIZED CLAIM(583) ;7/3/2001
 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
EN D HOME^%ZIS N FBCRT,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
DIS ;display claim
 D PAGE
 S FBDA=+$G(^TMP("FBAR",$J,+Y)),DA=FBDA,DR="",DIQ(0)="C",DIC="^FB583(" D EN^DIQ K DIQ
 K FBAR,^TMP("FBAR",$J)
PEND ;display incomplete items if information pending
 I IOSL<($Y+10) D PAGE G:FBOUT END
 I $$PEND^FBUCUTL(FBDA) 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 IOSL<($Y+5) D PAGE G:FBOUT END
 I $$PAY^FBUCUTL(FBDA,"FB583(") S FBX="< PAYMENTS ON FILE >" W !!?(IOM-$L(FBX)/2),FBX,!
LINK ;check for associates
 I IOSL<($Y+10) D PAGE G:FBOUT END
 S FBX="< ASSOCIATED CLAIMS >" I $$LINK^FBUCLNK1(FBDA,FBIX,1) W !!?(IOM-$L(FBX)/2),FBX,! D DISPX^FBUCUTL1(0) ;D ENTER^FBUCLNK1(FBDA,$$FBZ^FBUCUTL(FBDA),0)
END ;kill and quit
 ;I 'FBOUT,IOSL<($Y+10) D PAGE ;option defined as display, menuman to handle
 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