- 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 Feb 18, 2025@23:31:40 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 ;