Routine: FBUCOUT1

FBUCOUT1 ;ALBISC/TET - OUTPUTS cont'd ;6/27/2001

 ;;3.5;FEE BASIS;**32**;JAN 30, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

ONE ;display/print all claims for one vendor/veteran/other party

 ;sort by treatment from/to dates, group by master claim

 ;sort by vendor if vet or other selected, otherwise veteran

 ;'*' denotes secondary claim

 N FBI,FBIEN,FBIX,FBMC,FBOIEN,FBPTR,FBSORT,FBZ S (FBVEN,FBVET,FBOTH)=""

 D IEN^FBUCUTL3 G END:'FBIEN

 ; ask if report for just mill-bill (1725) or just non-mill bill claims

 S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END

 I FBIX="AOMS" S FBOIEN=FBIEN,FBOTH=$P($G(^VA(200,FBOIEN,0)),U),FBIEN=+$P($$FBZ^FBUCUTL(+$O(^FB583(FBIX,FBOIEN,0))),U,4)

 S:FBIX'="AVMS" FBVET=$P($G(^DPT(FBIEN,0)),U) S:FBIX="AVMS" FBVEN=$P($G(^FBAAV(FBIEN,0)),U)

Q ;que to print

 S:FBIX="AOMS" FBIEN=FBOIEN S VAR="FBIX^FBIEN^FBVEN^FBVET^FBOTH^FB1725R",VAL=VAR,PGM="SORT^FBUCOUT1" D ZIS^FBAAUTL G:FBPOP END

SORT ;sort all claims output

 U IO K ^TMP("FB",$J) N FBI,FBMC,FBZ

 S FBMC="" F  S FBMC=$O(^FB583(FBIX,FBIEN,FBMC)) Q:FBMC']""  S FBI=0 F  S FBI=$O(^FB583("AMC",+FBMC,FBI)) Q:'FBI  S FBZ=$G(^FB583(FBI,0)) I FBZ]"" D

 .; if user requested just mill-bill (1725) or non-mill bill claims then

 .; check claim and skip when appropriate

 .Q:$S(FB1725R="M"&'+$P(FBZ,U,28):1,FB1725R="N"&+$P(FBZ,U,28):1,1:0)

 .N FBPTR,FBSORT,NODE S FBPTR=$S(FBIX="AVMS":$P(FBZ,U,4),1:$P(FBZ,U,3))

 .S FBSORT=$P($$PTR^FBUCUTL($S(FBIX="AVMS":"^DPT(",1:"^FBAAV("),FBPTR),U) I FBIX="AVMS" S FBSORT=$E(FBSORT,1,30)

 .S NODE=$E($P($$PROG^FBUCUTL(+$P(FBZ,U,2)),U),1,15)_U_$E($P($$PTR^FBUCUTL("^FB(162.92,",$P(FBZ,U,24)),U),1,20) I "^40^70^90^"[$$ORDER^FBUCUTL($P(FBZ,U,24)) S NODE=NODE_U_$$CODE^FBUCOUT($P(FBZ,U,11))

 .S ^TMP("FB",$J,+$P(FBZ,U,5)_";"_+$P(FBZ,U,6),+FBMC_$S(+FBMC=FBI:"P",1:"S")_";"_FBI,$S(+FBMC=FBI:"",1:" *")_FBSORT_";"_FBPTR)=NODE

 .S FBMC=+FBMC_"z"

PRINT ;print all claims output

 N DIRUT,DTOUT,DUTOUT,FBCRT,FBDASH,FBDT,FBHDR,FBMC,FBN,FBNODE,FBOMC,FBOUT,FBPG

 S FBHDR=$S(FBIX="AVMS":"VENDOR: "_FBVEN,FBIX="APMS":"VETERAN: "_FBVET,1:"OTHER PARTY: "_FBOTH),FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBOUT=0,$P(FBDASH,"=",80)="" D PAGE

 S FBOMC=0,FBDT=""

 F  S FBDT=$O(^TMP("FB",$J,FBDT)) Q:FBDT']""!(FBOUT)  S FBMC="" F  S FBMC=$O(^TMP("FB",$J,FBDT,FBMC)) Q:FBMC']""  W:+FBOMC'=+FBMC !! S FBOMC=FBMC D  Q:FBOUT

 .S FBN="" F  S FBN=$O(^TMP("FB",$J,FBDT,FBMC,FBN)) Q:FBN']""  S FBNODE=$G(^TMP("FB",$J,FBDT,FBMC,FBN)) D  Q:FBOUT

 ..I IOSL<($Y+5) D PAGE Q:FBOUT

 ..W !,$P(FBN,";"),?34,$P(FBNODE,U),?53,$P(FBNODE,U,2),?75,$P(FBNODE,U,3)

 ..W !?3,"Treatment From: ",$$DATX^FBAAUTL($P(FBDT,";")),?29,"Treatment To: ",$$DATX^FBAAUTL($P(FBDT,";",2))

 ..I FBIX="AOMS" W ?54,"VETERAN: ",$E($$VET^FBUCUTL(+$P($$FBZ^FBUCUTL(+$P(FBMC,";",2)),U,4)),1,16)

END ;kill variables,tmp global and quit

 K FBIEN,FBIX,FBOTH,FBPOP,FBVEN,FBVET,PGM,POP,VAL,VAR,^TMP("FB",$J),FB1725R

 D CLOSE^FBAAUTL

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

CR ;ask end of page prompt

 ;OUTPUT: FBOUT is set if time out or up arrow out

 W ! S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCOUT1   3309     printed  Mar 13, 2025@21:05:18                                                                                                                                                                                                    Page 2

FBUCOUT1  ;ALBISC/TET - OUTPUTS cont'd ;6/27/2001

 +1       ;;3.5;FEE BASIS;**32**;JAN 30, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

ONE       ;display/print all claims for one vendor/veteran/other party

 +1       ;sort by treatment from/to dates, group by master claim

 +2       ;sort by vendor if vet or other selected, otherwise veteran

 +3       ;'*' denotes secondary claim

 +4        NEW FBI,FBIEN,FBIX,FBMC,FBOIEN,FBPTR,FBSORT,FBZ

           SET (FBVEN,FBVET,FBOTH)=""

 +5        DO IEN^FBUCUTL3

           if 'FBIEN

               GOTO END

 +6       ; ask if report for just mill-bill (1725) or just non-mill bill claims

 +7        SET FB1725R=$$ASKMB^FBUCUTL9

           IF FB1725R=""

               GOTO END

 +8        IF FBIX="AOMS"

               SET FBOIEN=FBIEN

               SET FBOTH=$PIECE($GET(^VA(200,FBOIEN,0)),U)

               SET FBIEN=+$PIECE($$FBZ^FBUCUTL(+$ORDER(^FB583(FBIX,FBOIEN,0))),U,4)

 +9        if FBIX'="AVMS"

               SET FBVET=$PIECE($GET(^DPT(FBIEN,0)),U)

           if FBIX="AVMS"

               SET FBVEN=$PIECE($GET(^FBAAV(FBIEN,0)),U)

Q         ;que to print

 +1        if FBIX="AOMS"

               SET FBIEN=FBOIEN

           SET VAR="FBIX^FBIEN^FBVEN^FBVET^FBOTH^FB1725R"

           SET VAL=VAR

           SET PGM="SORT^FBUCOUT1"

           DO ZIS^FBAAUTL

           if FBPOP

               GOTO END

SORT      ;sort all claims output

 +1        USE IO

           KILL ^TMP("FB",$JOB)

           NEW FBI,FBMC,FBZ

 +2        SET FBMC=""

FOR

               SET FBMC=$ORDER(^FB583(FBIX,FBIEN,FBMC))

               if FBMC']""

                   QUIT

               SET FBI=0

FOR

                   SET FBI=$ORDER(^FB583("AMC",+FBMC,FBI))

                   if 'FBI

                       QUIT

                   SET FBZ=$GET(^FB583(FBI,0))

                   IF FBZ]""

                       Begin DoDot:1

 +3       ; if user requested just mill-bill (1725) or non-mill bill claims then

 +4       ; check claim and skip when appropriate

 +5                        if $SELECT(FB1725R="M"&'+$PIECE(FBZ,U,28)

                               QUIT

 +6                        NEW FBPTR,FBSORT,NODE

                           SET FBPTR=$SELECT(FBIX="AVMS":$PIECE(FBZ,U,4),1:$PIECE(FBZ,U,3))

 +7                        SET FBSORT=$PIECE($$PTR^FBUCUTL($SELECT(FBIX="AVMS":"^DPT(",1:"^FBAAV("),FBPTR),U)

                           IF FBIX="AVMS"

                               SET FBSORT=$EXTRACT(FBSORT,1,30)

 +8                        SET NODE=$EXTRACT($PIECE($$PROG^FBUCUTL(+$PIECE(FBZ,U,2)),U),1,15)_U_$EXTRACT($PIECE($$PTR^FBUCUTL("^FB(162.92,",$PIECE(FBZ,U,24)),U),1,20)

                           IF "^40^70^90^"[$$ORDER^FBUCUTL($PIECE(FBZ,U,24))

                               SET NODE=NODE_U_$$CODE^FBUCOUT($PIECE(FBZ,U,11))

 +9                        SET ^TMP("FB",$JOB,+$PIECE(FBZ,U,5)_";"_+$PIECE(FBZ,U,6),+FBMC_$SELECT(+FBMC=FBI:"P",1:"S")_";"_FBI,$SELECT(+FBMC=FBI:"",1:" *")_FBSORT_";"_FBPTR)=NODE

 +10                       SET FBMC=+FBMC_"z"

                       End DoDot:1

PRINT     ;print all claims output

 +1        NEW DIRUT,DTOUT,DUTOUT,FBCRT,FBDASH,FBDT,FBHDR,FBMC,FBN,FBNODE,FBOMC,FBOUT,FBPG

 +2        SET FBHDR=$SELECT(FBIX="AVMS":"VENDOR: "_FBVEN,FBIX="APMS":"VETERAN: "_FBVET,1:"OTHER PARTY: "_FBOTH)

           SET FBPG=0

           SET FBCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)

           SET FBOUT=0

           SET $PIECE(FBDASH,"=",80)=""

           DO PAGE

 +3        SET FBOMC=0

           SET FBDT=""

 +4        FOR

               SET FBDT=$ORDER(^TMP("FB",$JOB,FBDT))

               if FBDT']""!(FBOUT)

                   QUIT

               SET FBMC=""

FOR

                   SET FBMC=$ORDER(^TMP("FB",$JOB,FBDT,FBMC))

                   if FBMC']""

                       QUIT

                   if +FBOMC'=+FBMC

                       WRITE !!

                   SET FBOMC=FBMC

                   Begin DoDot:1

 +5                    SET FBN=""

FOR

                           SET FBN=$ORDER(^TMP("FB",$JOB,FBDT,FBMC,FBN))

                           if FBN']""

                               QUIT

                           SET FBNODE=$GET(^TMP("FB",$JOB,FBDT,FBMC,FBN))

                           Begin DoDot:2

 +6                            IF IOSL<($Y+5)

                                   DO PAGE

                                   if FBOUT

                                       QUIT

 +7                            WRITE !,$PIECE(FBN,";"),?34,$PIECE(FBNODE,U),?53,$PIECE(FBNODE,U,2),?75,$PIECE(FBNODE,U,3)

 +8                            WRITE !?3,"Treatment From: ",$$DATX^FBAAUTL($PIECE(FBDT,";")),?29,"Treatment To: ",$$DATX^FBAAUTL($PIECE(FBDT,";",2))

 +9                            IF FBIX="AOMS"

                                   WRITE ?54,"VETERAN: ",$EXTRACT($$VET^FBUCUTL(+$PIECE($$FBZ^FBUCUTL(+$PIECE(FBMC,";",2)),U,4)),1,16)

                           End DoDot:2

                           if FBOUT

                               QUIT

                   End DoDot:1

                   if FBOUT

                       QUIT

END       ;kill variables,tmp global and quit

 +1        KILL FBIEN,FBIX,FBOTH,FBPOP,FBVEN,FBVET,PGM,POP,VAL,VAR,^TMP("FB",$JOB),FB1725R

 +2        DO CLOSE^FBAAUTL

 +3        QUIT

PAGE      ;write new page

 +1        if FBCRT&(FBPG>0)

               DO CR

           if FBOUT

               QUIT

HDR        if FBCRT!(FBPG>0)

               WRITE @IOF

           SET FBPG=FBPG+1

 +1        WRITE !,FBHDR,!?70,"Page: ",FBPG,!,$SELECT(FBIX="AVMS":"Veteran",1:"Vendor"),?34,"Fee Program",?53,"Status",?75,"Code",!,FBDASH

 +2        QUIT

CR        ;ask end of page prompt

 +1       ;OUTPUT: FBOUT is set if time out or up arrow out

 +2        WRITE !

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

           if $DATA(DTOUT)!($DATA(DUOUT))

               SET FBOUT=1

 +3        QUIT

FBUCOUT1.m