[613] | 1 | PRCH58 ;WISC/CLH-1358 FUNCTIONS UTILITY ;9/10/92 8:44 AM
|
---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | BAL(Y) ;return 1358 balances
|
---|
| 5 | ;input internal obligation number
|
---|
| 6 | S Y=$S($G(Y)="":-1,1:$G(^PRC(442,Y,8)))
|
---|
| 7 | Q Y
|
---|
| 8 | BALUP(PODA,BAL1) ;update amount of total authorizations
|
---|
| 9 | N DIE,DR,DA,X,NBAL,ABAL
|
---|
| 10 | S NBAL=$P($G(^PRC(442,PODA,8)),U,3),NBAL=NBAL+BAL1
|
---|
| 11 | S DIE="^PRC(442,",DR="96////^S X=NBAL",DA=PODA D ^DIE
|
---|
| 12 | Q
|
---|
| 13 | BALOB(PODA,AMT) ;obligation balance
|
---|
| 14 | N DIE,DR,DA,X
|
---|
| 15 | S DIE="^PRC(442,",DR="94////^S X=AMT",DA=PODA D ^DIE
|
---|
| 16 | Q
|
---|
| 17 | ;
|
---|
| 18 | BALAU(PODA,AMT) N DIE,DR,DA,X
|
---|
| 19 | S DIE="^PRC(442,",DR="96////^S X=AMT",DA=PODA D ^DIE
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | BUL(PODA) ;set bulletin node in 442
|
---|
| 23 | S $P(^PRC(442,PODA,8),U,6)=1
|
---|
| 24 | Q
|
---|
| 25 | ;
|
---|
| 26 | BULC(PODA) ;clear bulletin node in 442
|
---|
| 27 | S $P(^PRC(442,PODA,8),U,6)=0
|
---|
| 28 | Q
|
---|
| 29 | ;
|
---|
| 30 | DATE() ;date time conversion
|
---|
| 31 | N %,X,Y
|
---|
| 32 | D NOW^%DTC
|
---|
| 33 | S Y=% D DD^%DT
|
---|
| 34 | Q Y
|
---|
| 35 | ;
|
---|