31 lines
1.7 KiB
Mathematica
31 lines
1.7 KiB
Mathematica
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
|