source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCEBAL.m@ 1259

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