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

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1PRCEBAL ;WISC/LDB/BGJ-DISPLAY BALANCES ;8/7/92 11:31 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;Display obligation,liquidation and authorization balances
5FISCAL D EXIT S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) D OBLK^PRCH58OB(.PODA)
6 I 'PODA D EXIT Q
7 I (+PODA(1)'=PRC("SITE")) D EXIT Q
8 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)
9 D DISP,EXIT Q
10FCP D EXIT,EN3^PRCSUT I '$D(PRC("CP"))!'$D(PRC("SITE")) D EXIT Q
11 D OBLK^PRCH58OB(.PODA,+PRC("CP"))
12 Q:'PODA I (+PODA(0)'=PRC("SITE"))!(+PODA(2)'=+PRC("CP"))!('$P(PODA(0),U,12)) D EXIT Q
13 S PO=$P(PODA(0),U,12) D NODE^PRCS58OB(PO,.TRNODE)
14 S PO=PODA(1)
15DISP S BAL=$$BAL^PRCH58(PODA)
16 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
17 . 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)
18 W @IOF,?25,PO," OBLIGATION BALANCES"
19 W !!," OBLIGATION AMOUNT: $",$$LBF1^PRCFU($FN(+BAL,",P",2),14)
20 W ?37," SERVICE BALANCE: $",$$LBF1^PRCFU($FN(+BAL-$P(BAL,U,3),",P",2),14)
21 W !,"LIQUIDATION BALANCE: $",$$LBF1^PRCFU($FN(+BAL-$P(BAL,U,2),",P",2),14)
22 W ?37,"TOTAL LIQUIDATIONS: $",$$LBF1^PRCFU($FN(+$P(BAL,U,2),",P",2),14)
23 W !!,"AUTHORIZATION BALANCE(S): ",! S AUDA=0
24 S AUDA=0 F S AUDA=$O(AUAMT(AUDA)) Q:'AUDA I $D(^PRC(424,AUDA,0)) D
25 .W !,$P(AUAMT(AUDA),U)
26 .W ?16,"AMOUNT: $",$$LBF1^PRCFU($FN($P(AUAMT(AUDA),U,2),",P",2),14)
27 .W ?48,"BALANCE: $",$$LBF1^PRCFU($FN($P(AUAMT(AUDA),U,3),",P",2),14)
28 W !!," AUTHORIZATION TOTAL: $",$$LBF1^PRCFU($FN(AMT,",P",2),14)
29EXIT K AMT,AUAMT,AUDA,BAL,BAL1,DA,DIC,DRAMT,FCPAMT,LQAMT,PO,PODA,PRC,PRCF,Y,TRNODE
30 Q
Note: See TracBrowser for help on using the repository browser.