FBUCOUT.m

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 ---FBUCOUT   1525     printed  Apr 09, 2024@21:01:18                                                                                                                                                                                                     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       ;