PRCH58 ;WISC/CLH-1358 FUNCTIONS UTILITY ;9/10/92 8:44 AM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
BAL(Y) ;return 1358 balances
;input internal obligation number
S Y=$S($G(Y)="":-1,1:$G(^PRC(442,Y,8)))
Q Y
BALUP(PODA,BAL1) ;update amount of total authorizations
N DIE,DR,DA,X,NBAL,ABAL
S NBAL=$P($G(^PRC(442,PODA,8)),U,3),NBAL=NBAL+BAL1
S DIE="^PRC(442,",DR="96////^S X=NBAL",DA=PODA D ^DIE
Q
BALOB(PODA,AMT) ;obligation balance
N DIE,DR,DA,X
S DIE="^PRC(442,",DR="94////^S X=AMT",DA=PODA D ^DIE
Q
;
BALAU(PODA,AMT) N DIE,DR,DA,X
S DIE="^PRC(442,",DR="96////^S X=AMT",DA=PODA D ^DIE
Q
;
BUL(PODA) ;set bulletin node in 442
S $P(^PRC(442,PODA,8),U,6)=1
Q
;
BULC(PODA) ;clear bulletin node in 442
S $P(^PRC(442,PODA,8),U,6)=0
Q
;
DATE() ;date time conversion
N %,X,Y
D NOW^%DTC
S Y=% D DD^%DT
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCH58 913 printed Sep 23, 2025@19:41:22 Page 2
PRCH58 ;WISC/CLH-1358 FUNCTIONS UTILITY ;9/10/92 8:44 AM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
BAL(Y) ;return 1358 balances
+1 ;input internal obligation number
+2 SET Y=$SELECT($GET(Y)="":-1,1:$GET(^PRC(442,Y,8)))
+3 QUIT Y
BALUP(PODA,BAL1) ;update amount of total authorizations
+1 NEW DIE,DR,DA,X,NBAL,ABAL
+2 SET NBAL=$PIECE($GET(^PRC(442,PODA,8)),U,3)
SET NBAL=NBAL+BAL1
+3 SET DIE="^PRC(442,"
SET DR="96////^S X=NBAL"
SET DA=PODA
DO ^DIE
+4 QUIT
BALOB(PODA,AMT) ;obligation balance
+1 NEW DIE,DR,DA,X
+2 SET DIE="^PRC(442,"
SET DR="94////^S X=AMT"
SET DA=PODA
DO ^DIE
+3 QUIT
+4 ;
BALAU(PODA,AMT) NEW DIE,DR,DA,X
+1 SET DIE="^PRC(442,"
SET DR="96////^S X=AMT"
SET DA=PODA
DO ^DIE
+2 QUIT
+3 ;
BUL(PODA) ;set bulletin node in 442
+1 SET $PIECE(^PRC(442,PODA,8),U,6)=1
+2 QUIT
+3 ;
BULC(PODA) ;clear bulletin node in 442
+1 SET $PIECE(^PRC(442,PODA,8),U,6)=0
+2 QUIT
+3 ;
DATE() ;date time conversion
+1 NEW %,X,Y
+2 DO NOW^%DTC
+3 SET Y=%
DO DD^%DT
+4 QUIT Y
+5 ;
