PRCH58.m

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 ---PRCH58   913     printed  Apr 09, 2024@21:08:33                                                                                                                                                                                                       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       ;