source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH58.m@ 1240

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

initial load of WorldVistAEHR

File size: 878 bytes
RevLine 
[613]1PRCH58 ;WISC/CLH-1358 FUNCTIONS UTILITY ;9/10/92 8:44 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4BAL(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
8BALUP(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
13BALOB(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 ;
18BALAU(PODA,AMT) N DIE,DR,DA,X
19 S DIE="^PRC(442,",DR="96////^S X=AMT",DA=PODA D ^DIE
20 Q
21 ;
22BUL(PODA) ;set bulletin node in 442
23 S $P(^PRC(442,PODA,8),U,6)=1
24 Q
25 ;
26BULC(PODA) ;clear bulletin node in 442
27 S $P(^PRC(442,PODA,8),U,6)=0
28 Q
29 ;
30DATE() ;date time conversion
31 N %,X,Y
32 D NOW^%DTC
33 S Y=% D DD^%DT
34 Q Y
35 ;
Note: See TracBrowser for help on using the repository browser.