Routine: FBCHDI

FBCHDI ;AISC/DMK,TET-DISPLAY INVOICE ;10/22/92  12:35

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

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

ASKIN K FBAANQ W !! S DIC="^FBAAI(",DIC(0)="AEQM" D ^DIC G END:X="^"!(X=""),ASKIN:Y<0 S FBI=+Y

 S VAR="FBI",VAL=FBI,PGM="START^FBCHDI" D ZIS^FBAAUTL G:FBPOP END S:IO=IO(0) FBAANQ=1

START S Q="",$P(Q,"=",80)="=",FBAAOUT=0 U IO D VET

EN K ^TMP($J,"FB") D:'$D(FBPG) INIT

 D SET^FBPAY67 D:$G(FBLISTC)&($E(IOST,1,2)["C-") CR^FBPAY21 G:FBOUT END D EN1^FBPAY671 G:FBAAOUT!(FBOUT) END

 F J=5,16,17 S FBIN(J)=$P(FBIN,"^",J)

 S Y=FBIN(16) D PDF^FBAAUTL S FBIN(16)=Y S:$P(FBIN(5),";",2)="FB583(" FBIN(5)="" I FBIN(5)]"" S FBIN(5)=$S($D(^FB7078(+FBIN(5),0)):$P(^(0),"^",1),1:"")

 I FBIN(17)]"" S FBIN(17)=$S($D(^FBAA(161.7,FBIN(17),0)):$P(^(0),"^",1),1:"")

 I FBIN(5)]"" W !,?4,"Associated 7078: ",FBIN(5)

 W !,?4,"Batch #: ",FBIN(17),?40,"Date Finalized: ",FBIN(16),!

 I $D(^FBAAI(FBI,"FBREJ")),$P(^("FBREJ"),"^",1)]"" W ?4,"Rejects Pending!",?25,"Reject reason: ",$P(^("FBREJ"),"^",2),!,?4,"Old Batch #: ",$S($P(^("FBREJ"),"^",3):$S($D(^FBAA(161.7,$P(^("FBREJ"),"^",3),0)):$P(^(0),"^"),1:""),1:"")

 Q:$D(FBLISTC)

 G:$D(FBAANQ) ASKIN

END K VA,FBINODE,FBNODE,FBPRGNAM,FBPROG,FBDX,FBDX1,FBPAT,FBPROC,FBVEN,FBPG,FBAAOUT,FBPROC1,Q D KILL^FBPAY Q

INIT ;initialize variables needed in fbpay67&671

 S (FBPROG,FBSORT)=1,FBPG=$S($G(FBLISTC):1,1:0),FBCRT=$S($E(IOST,1,2)="C-":1,1:0),$P(FBDASH,"=",80)="",$P(FBDASH1,"-",80)="",FBOUT=0

VET ;set vet variables

 S FBINODE=$G(^FBAAI(FBI,0)),DFN=+$P(FBINODE,U,4),FBPNAME=$P($G(^DPT(DFN,0)),U),FBPID=$$SSN^FBAAUTL(DFN),FBPROG=$P(FBINODE,U,12),FBPRGNAM=$P($G(^FBAA(161.8,+FBPROG,0)),U),FBPROG(+FBPROG)=FBPRGNAM

 S FBIEN=DFN,FBPI=FBPROG,FBM=+$P(FBINODE,U,6) S:FBPNAME']"" FBPNAME="UNKNOWN" S:FBPRGNAM']"" FBPRGNAM="UNKNOWN"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHDI   1828     printed  Mar 13, 2025@21:02:20                                                                                                                                                                                                      Page 2

FBCHDI    ;AISC/DMK,TET-DISPLAY INVOICE ;10/22/92  12:35

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

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

ASKIN      KILL FBAANQ

           WRITE !!

           SET DIC="^FBAAI("

           SET DIC(0)="AEQM"

           DO ^DIC

           if X="^"!(X="")

               GOTO END

           if Y<0

               GOTO ASKIN

           SET FBI=+Y

 +1        SET VAR="FBI"

           SET VAL=FBI

           SET PGM="START^FBCHDI"

           DO ZIS^FBAAUTL

           if FBPOP

               GOTO END

           if IO=IO(0)

               SET FBAANQ=1

START      SET Q=""

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

           SET FBAAOUT=0

           USE IO

           DO VET

EN         KILL ^TMP($JOB,"FB")

           if '$DATA(FBPG)

               DO INIT

 +1        DO SET^FBPAY67

           if $GET(FBLISTC)&($EXTRACT(IOST,1,2)["C-")

               DO CR^FBPAY21

           if FBOUT

               GOTO END

           DO EN1^FBPAY671

           if FBAAOUT!(FBOUT)

               GOTO END

 +2        FOR J=5,16,17

               SET FBIN(J)=$PIECE(FBIN,"^",J)

 +3        SET Y=FBIN(16)

           DO PDF^FBAAUTL

           SET FBIN(16)=Y

           if $PIECE(FBIN(5),";",2)="FB583("

               SET FBIN(5)=""

           IF FBIN(5)]""

               SET FBIN(5)=$SELECT($DATA(^FB7078(+FBIN(5),0)):$PIECE(^(0),"^",1),1:"")

 +4        IF FBIN(17)]""

               SET FBIN(17)=$SELECT($DATA(^FBAA(161.7,FBIN(17),0)):$PIECE(^(0),"^",1),1:"")

 +5        IF FBIN(5)]""

               WRITE !,?4,"Associated 7078: ",FBIN(5)

 +6        WRITE !,?4,"Batch #: ",FBIN(17),?40,"Date Finalized: ",FBIN(16),!

 +7        IF $DATA(^FBAAI(FBI,"FBREJ"))

               IF $PIECE(^("FBREJ"),"^",1)]""

                   WRITE ?4,"Rejects Pending!",?25,"Reject reason: ",$PIECE(^("FBREJ"),"^",2),!,?4,"Old Batch #: ",$SELECT($PIECE(^("FBREJ"),"^",3):$SELECT($DATA(^FBAA(161.7,$PIECE(^("FBREJ"),"^",3),0)):$PIECE(^(0),"^"),1:""),1:"")

 +8        if $DATA(FBLISTC)

               QUIT

 +9        if $DATA(FBAANQ)

               GOTO ASKIN

END        KILL VA,FBINODE,FBNODE,FBPRGNAM,FBPROG,FBDX,FBDX1,FBPAT,FBPROC,FBVEN,FBPG,FBAAOUT,FBPROC1,Q

           DO KILL^FBPAY

           QUIT

INIT      ;initialize variables needed in fbpay67&671

 +1        SET (FBPROG,FBSORT)=1

           SET FBPG=$SELECT($GET(FBLISTC):1,1:0)

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

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

           SET $PIECE(FBDASH1,"-",80)=""

           SET FBOUT=0

 +2        QUIT

VET       ;set vet variables

 +1        SET FBINODE=$GET(^FBAAI(FBI,0))

           SET DFN=+$PIECE(FBINODE,U,4)

           SET FBPNAME=$PIECE($GET(^DPT(DFN,0)),U)

           SET FBPID=$$SSN^FBAAUTL(DFN)

           SET FBPROG=$PIECE(FBINODE,U,12)

           SET FBPRGNAM=$PIECE($GET(^FBAA(161.8,+FBPROG,0)),U)

           SET FBPROG(+FBPROG)=FBPRGNAM

 +2        SET FBIEN=DFN

           SET FBPI=FBPROG

           SET FBM=+$PIECE(FBINODE,U,6)

           if FBPNAME']""

               SET FBPNAME="UNKNOWN"

           if FBPRGNAM']""

               SET FBPRGNAM="UNKNOWN"

 +3        QUIT

FBCHDI.m