source: FOIAVistA/tag/r/FEE_BASIS-FB/FBUCDIS.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1FBUCDIS ;AISC/TET-DISPLAY UNAUTHORIZED CLAIM(583) ;7/3/2001
2 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN D HOME^%ZIS N FBCRT,FBOUT,FBPG,FBX S FBOUT=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBPG=0
5 W !! D IEN^FBUCUTL3 G:'FBIEN END ;select claim
6 ; ask if list for just mill-bill (1725) or just non-mill bill claims
7 S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
8 D DISP7^FBUCUTL5(FBIX,FBIEN,0,FB1725R) ;set array of claims
9 D DISPX^FBUCUTL1(0) ;display claims
10 S FBAR=$G(^TMP("FBAR",$J,"FBAR")) I 'FBAR G END ;W !!,"No data on file." G EN
11 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
12DIS ;display claim
13 D PAGE
14 S FBDA=+$G(^TMP("FBAR",$J,+Y)),DA=FBDA,DR="",DIQ(0)="C",DIC="^FB583(" D EN^DIQ K DIQ
15 K FBAR,^TMP("FBAR",$J)
16PEND ;display incomplete items if information pending
17 I IOSL<($Y+10) D PAGE G:FBOUT END
18 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)
19 G:FBOUT END
20PAY ;check if any payments
21 I IOSL<($Y+5) D PAGE G:FBOUT END
22 I $$PAY^FBUCUTL(FBDA,"FB583(") S FBX="< PAYMENTS ON FILE >" W !!?(IOM-$L(FBX)/2),FBX,!
23LINK ;check for associates
24 I IOSL<($Y+10) D PAGE G:FBOUT END
25 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)
26END ;kill and quit
27 ;I 'FBOUT,IOSL<($Y+10) D PAGE ;option defined as display, menuman to handle
28 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
29 K FBARY,^TMP("FBARY",$J),^TMP("FBAR",$J) Q
30PAGE ;write new page
31 D:FBCRT&(FBPG>0) CR Q:FBOUT
32HDR W:FBCRT!(FBPG>0) @IOF S FBPG=FBPG+1
33 ;W !,FBHDR,!?70,"Page: ",FBPG,!,$S(FBIX="AVMS":"Veteran",1:"Vendor"),?34,"Fee Program",?53,"Status",?75,"Code",!,FBDASH
34 Q
35CR ;ask end of page prompt
36 ;OUTPUT: FBOUT is set if time out or up arrow out
37 W ! S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1
38 Q
39 S FBDA=FBDA_";FB583(",FBLISTC=1,FBOUT=0,FBAAOUT="",Q="",$P(Q,"-",80)="-",FB("PD")=0
40 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)
41 D END G EN
42HED W !?25,"ASSOCIATED INVOICES",!,?24,$E(Q,1,21),!
43 Q
44OPT 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
45 K II,JJ,KK Q
46GETPD I $D(^FBAAC(FB("DFN"),1,II,1,JJ,1,KK,0)) S FB("PD")=FB("PD")+$P(^(0),"^",3) Q
47 ;
48RETURN ;return address display/edit
49 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
50 ;display return address
51RETDIS D STATADD^FBUCUTL2 ;get station address
52 D PAGE
53 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
54 ;edit return address
55 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
56 G:'FBED END
57 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)
58 K DA,DIE,DR,FBLOCK
59 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
60 G END:'FBDIS G END:FBOUT K FBSADD G RETDIS
Note: See TracBrowser for help on using the repository browser.