- FBUCOUT ;ALBISC/TET - OUTPUTS ;7/18/2001
- ;;3.5;FEE BASIS;**32**;JAN 30, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ASK ;ask search/sort questions
- ; ask if report for just mill-bill (1725) or just non-mill bill claims
- S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
- 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)_"]"
- D DISP92^FBUCUTL5,DISPX^FBUCUTL1(1) ;set array,display
- 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)))=""
- S DIS(0)="I $D(FBARY(+$P($G(^FB583(D0,0)),U,24)))"
- ; if just mill bill or non-mill bill then set screen and title
- I FB1725R="M" D
- . S DIS(1)="I $P($G(^FB583(D0,0)),U,28)=1"
- . S DHD="STATUS LISTING OF MILL BILL (1725) CLAIMS"
- I FB1725R="N" D
- . S DIS(1)="I $P($G(^FB583(D0,0)),U,28)'=1"
- . S DHD="STATUS LISTING OF UNAUTH. NON-MILL BILL CLAIMS"
- S L=0,DIC="^FB583(",BY=FLDS,FR="?,@,@,,@,@,@",TO="?,,,,,,"
- S FBDT=DT,FBZLOW=FBDT,FBZHI=$$CDTC^FBUCUTL(FBDT,30)
- D EN1^DIP
- ;set up variable fbexp
- ;set up dip variables, call dip
- END ;kill and quit
- 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
- Q
- CODE(X) ;dispostion code of disposition if status order is 40,70 or 90
- ; 40=dispositioned,70=appeal dispositioned,90=bva appeal dispositioned
- I '+X Q ""
- Q $P($$PTR^FBUCUTL("^FB(162.91,",X),U,3)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCOUT 1525 printed Dec 13, 2024@02:00:23 Page 2
- FBUCOUT ;ALBISC/TET - OUTPUTS ;7/18/2001
- +1 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ASK ;ask search/sort questions
- +1 ; ask if report for just mill-bill (1725) or just non-mill bill claims
- +2 SET FB1725R=$$ASKMB^FBUCUTL9
- IF FB1725R=""
- GOTO END
- +3 SET DIR(0)="SM^1:PATIENT;2:VENDOR"
- SET DIR("A")="Sort by"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO END
- if '+Y!($GET(Y(0))']"")
- GOTO ASK
- SET FLDS="[FBUC STATUS BY "_Y(0)_"]"
- +4 ;set array,display
- DO DISP92^FBUCUTL5
- DO DISPX^FBUCUTL1(1)
- +5 if FBOUT
- GOTO END
- if '+FBARY
- GOTO ASK
- SET FBI=0
- FOR
- SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
- if 'FBI
- QUIT
- SET FBARY(+$GET(^TMP("FBARY",$JOB,FBI)))=""
- +6 SET DIS(0)="I $D(FBARY(+$P($G(^FB583(D0,0)),U,24)))"
- +7 ; if just mill bill or non-mill bill then set screen and title
- +8 IF FB1725R="M"
- Begin DoDot:1
- +9 SET DIS(1)="I $P($G(^FB583(D0,0)),U,28)=1"
- +10 SET DHD="STATUS LISTING OF MILL BILL (1725) CLAIMS"
- End DoDot:1
- +11 IF FB1725R="N"
- Begin DoDot:1
- +12 SET DIS(1)="I $P($G(^FB583(D0,0)),U,28)'=1"
- +13 SET DHD="STATUS LISTING OF UNAUTH. NON-MILL BILL CLAIMS"
- End DoDot:1
- +14 SET L=0
- SET DIC="^FB583("
- SET BY=FLDS
- SET FR="?,@,@,,@,@,@"
- SET TO="?,,,,,,"
- +15 SET FBDT=DT
- SET FBZLOW=FBDT
- SET FBZHI=$$CDTC^FBUCUTL(FBDT,30)
- +16 DO EN1^DIP
- +17 ;set up variable fbexp
- +18 ;set up dip variables, call dip
- END ;kill and quit
- +1 KILL FBARY,FBDT,FBEXP,FBI,FBOUT,FBZLOW,FBZHI,BY,DIC,DIR,DIRUT,DIS,DTOUT,DUOUT,FLDS,FR,L,TO,Y,^TMP("FBAR",$JOB),^TMP("FBARY",$JOB),FB1725R,DHD
- +2 QUIT
- CODE(X) ;dispostion code of disposition if status order is 40,70 or 90
- +1 ; 40=dispositioned,70=appeal dispositioned,90=bva appeal dispositioned
- +2 IF '+X
- QUIT ""
- +3 QUIT $PIECE($$PTR^FBUCUTL("^FB(162.91,",X),U,3)
- +4 ;