source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCOUT.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1FBUCOUT ;ALBISC/TET - OUTPUTS ;7/18/2001
2 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4ASK ;ask search/sort questions
5 ; ask if report for just mill-bill (1725) or just non-mill bill claims
6 S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
7 S DIR(0)="SM^1:PATIENT;2:VENDOR",DIR("A")="Sort by" D ^DIR K DIR G END:$D(DIRUT),ASK:'+Y!($G(Y(0))']"") S FLDS="[FBUC STATUS BY "_Y(0)_"]"
8 D DISP92^FBUCUTL5,DISPX^FBUCUTL1(1) ;set array,display
9 G END:FBOUT,ASK:'+FBARY S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI S FBARY(+$G(^TMP("FBARY",$J,FBI)))=""
10 S DIS(0)="I $D(FBARY(+$P($G(^FB583(D0,0)),U,24)))"
11 ; if just mill bill or non-mill bill then set screen and title
12 I FB1725R="M" D
13 . S DIS(1)="I $P($G(^FB583(D0,0)),U,28)=1"
14 . S DHD="STATUS LISTING OF MILL BILL (1725) CLAIMS"
15 I FB1725R="N" D
16 . S DIS(1)="I $P($G(^FB583(D0,0)),U,28)'=1"
17 . S DHD="STATUS LISTING OF UNAUTH. NON-MILL BILL CLAIMS"
18 S L=0,DIC="^FB583(",BY=FLDS,FR="?,@,@,,@,@,@",TO="?,,,,,,"
19 S FBDT=DT,FBZLOW=FBDT,FBZHI=$$CDTC^FBUCUTL(FBDT,30)
20 D EN1^DIP
21 ;set up variable fbexp
22 ;set up dip variables, call dip
23END ;kill and quit
24 K FBARY,FBDT,FBEXP,FBI,FBOUT,FBZLOW,FBZHI,BY,DIC,DIR,DIRUT,DIS,DTOUT,DUOUT,FLDS,FR,L,TO,Y,^TMP("FBAR",$J),^TMP("FBARY",$J),FB1725R,DHD
25 Q
26CODE(X) ;dispostion code of disposition if status order is 40,70 or 90
27 ; 40=dispositioned,70=appeal dispositioned,90=bva appeal dispositioned
28 I '+X Q ""
29 Q $P($$PTR^FBUCUTL("^FB(162.91,",X),U,3)
30 ;
Note: See TracBrowser for help on using the repository browser.