- PRCEBAL ;WISC/LDB/BGJ-DISPLAY BALANCES ;8/7/92 11:31 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;Display obligation,liquidation and authorization balances
- FISCAL D EXIT S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) D OBLK^PRCH58OB(.PODA)
- I 'PODA D EXIT Q
- I (+PODA(1)'=PRC("SITE")) D EXIT Q
- G:'$P(PODA(0),U,12) EXIT S PO=$P(PODA(0),U,12) D NODE^PRCS58OB(PO,.TRNODE) G:$P($G(TRNODE(0)),U,4)'=1 EXIT S PO=PODA(1)
- D DISP,EXIT Q
- FCP D EXIT,EN3^PRCSUT I '$D(PRC("CP"))!'$D(PRC("SITE")) D EXIT Q
- D OBLK^PRCH58OB(.PODA,+PRC("CP"))
- Q:'PODA I (+PODA(0)'=PRC("SITE"))!(+PODA(2)'=+PRC("CP"))!('$P(PODA(0),U,12)) D EXIT Q
- S PO=$P(PODA(0),U,12) D NODE^PRCS58OB(PO,.TRNODE)
- S PO=PODA(1)
- DISP S BAL=$$BAL^PRCH58(PODA)
- S (AMT,AUDA)=0 F S AUDA=$O(^PRC(424,"AD",PO,AUDA)) Q:'AUDA I $D(^PRC(424,AUDA,0)),$P(^(0),U,3)="AU" D
- . S AMT=$P(^PRC(424,AUDA,0),U,12)+AMT,AUAMT(AUDA)=$P(^(0),U)_U_$P(^(0),U,12)_U_$P(^(0),U,5)
- W @IOF,?25,PO," OBLIGATION BALANCES"
- W !!," OBLIGATION AMOUNT: $",$$LBF1^PRCFU($FN(+BAL,",P",2),14)
- W ?37," SERVICE BALANCE: $",$$LBF1^PRCFU($FN(+BAL-$P(BAL,U,3),",P",2),14)
- W !,"LIQUIDATION BALANCE: $",$$LBF1^PRCFU($FN(+BAL-$P(BAL,U,2),",P",2),14)
- W ?37,"TOTAL LIQUIDATIONS: $",$$LBF1^PRCFU($FN(+$P(BAL,U,2),",P",2),14)
- W !!,"AUTHORIZATION BALANCE(S): ",! S AUDA=0
- S AUDA=0 F S AUDA=$O(AUAMT(AUDA)) Q:'AUDA I $D(^PRC(424,AUDA,0)) D
- .W !,$P(AUAMT(AUDA),U)
- .W ?16,"AMOUNT: $",$$LBF1^PRCFU($FN($P(AUAMT(AUDA),U,2),",P",2),14)
- .W ?48,"BALANCE: $",$$LBF1^PRCFU($FN($P(AUAMT(AUDA),U,3),",P",2),14)
- W !!," AUTHORIZATION TOTAL: $",$$LBF1^PRCFU($FN(AMT,",P",2),14)
- EXIT K AMT,AUAMT,AUDA,BAL,BAL1,DA,DIC,DRAMT,FCPAMT,LQAMT,PO,PODA,PRC,PRCF,Y,TRNODE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCEBAL 1767 printed Jan 18, 2025@03:02:30 Page 2
- PRCEBAL ;WISC/LDB/BGJ-DISPLAY BALANCES ;8/7/92 11:31 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;Display obligation,liquidation and authorization balances
- FISCAL DO EXIT
- SET PRCF("X")="S"
- DO ^PRCFSITE
- if '$DATA(PRC("SITE"))
- QUIT
- DO OBLK^PRCH58OB(.PODA)
- +1 IF 'PODA
- DO EXIT
- QUIT
- +2 IF (+PODA(1)'=PRC("SITE"))
- DO EXIT
- QUIT
- +3 if '$PIECE(PODA(0),U,12)
- GOTO EXIT
- SET PO=$PIECE(PODA(0),U,12)
- DO NODE^PRCS58OB(PO,.TRNODE)
- if $PIECE($GET(TRNODE(0)),U,4)'=1
- GOTO EXIT
- SET PO=PODA(1)
- +4 DO DISP
- DO EXIT
- QUIT
- FCP DO EXIT
- DO EN3^PRCSUT
- IF '$DATA(PRC("CP"))!'$DATA(PRC("SITE"))
- DO EXIT
- QUIT
- +1 DO OBLK^PRCH58OB(.PODA,+PRC("CP"))
- +2 if 'PODA
- QUIT
- IF (+PODA(0)'=PRC("SITE"))!(+PODA(2)'=+PRC("CP"))!('$PIECE(PODA(0),U,12))
- DO EXIT
- QUIT
- +3 SET PO=$PIECE(PODA(0),U,12)
- DO NODE^PRCS58OB(PO,.TRNODE)
- +4 SET PO=PODA(1)
- DISP SET BAL=$$BAL^PRCH58(PODA)
- +1 SET (AMT,AUDA)=0
- FOR
- SET AUDA=$ORDER(^PRC(424,"AD",PO,AUDA))
- if 'AUDA
- QUIT
- IF $DATA(^PRC(424,AUDA,0))
- IF $PIECE(^(0),U,3)="AU"
- Begin DoDot:1
- +2 SET AMT=$PIECE(^PRC(424,AUDA,0),U,12)+AMT
- SET AUAMT(AUDA)=$PIECE(^(0),U)_U_$PIECE(^(0),U,12)_U_$PIECE(^(0),U,5)
- End DoDot:1
- +3 WRITE @IOF,?25,PO," OBLIGATION BALANCES"
- +4 WRITE !!," OBLIGATION AMOUNT: $",$$LBF1^PRCFU($FNUMBER(+BAL,",P",2),14)
- +5 WRITE ?37," SERVICE BALANCE: $",$$LBF1^PRCFU($FNUMBER(+BAL-$PIECE(BAL,U,3),",P",2),14)
- +6 WRITE !,"LIQUIDATION BALANCE: $",$$LBF1^PRCFU($FNUMBER(+BAL-$PIECE(BAL,U,2),",P",2),14)
- +7 WRITE ?37,"TOTAL LIQUIDATIONS: $",$$LBF1^PRCFU($FNUMBER(+$PIECE(BAL,U,2),",P",2),14)
- +8 WRITE !!,"AUTHORIZATION BALANCE(S): ",!
- SET AUDA=0
- +9 SET AUDA=0
- FOR
- SET AUDA=$ORDER(AUAMT(AUDA))
- if 'AUDA
- QUIT
- IF $DATA(^PRC(424,AUDA,0))
- Begin DoDot:1
- +10 WRITE !,$PIECE(AUAMT(AUDA),U)
- +11 WRITE ?16,"AMOUNT: $",$$LBF1^PRCFU($FNUMBER($PIECE(AUAMT(AUDA),U,2),",P",2),14)
- +12 WRITE ?48,"BALANCE: $",$$LBF1^PRCFU($FNUMBER($PIECE(AUAMT(AUDA),U,3),",P",2),14)
- End DoDot:1
- +13 WRITE !!," AUTHORIZATION TOTAL: $",$$LBF1^PRCFU($FNUMBER(AMT,",P",2),14)
- EXIT KILL AMT,AUAMT,AUDA,BAL,BAL1,DA,DIC,DRAMT,FCPAMT,LQAMT,PO,PODA,PRC,PRCF,Y,TRNODE
- +1 QUIT