PRCPU441.m

PRCPU441 ;WISC/RFJ-master item file utilities                       ;10 Feb 91

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

PURCHASE(ITEMDA) ;  return 1 if item is purchasable

 Q $S($P($G(^PRC(441,+ITEMDA,0)),"^",6)'="S":1,1:0)

 ;

 ;

REUSABLE(ITEMDA) ;  return if item is resuable or disposable

 Q $S($P($G(^PRC(441,+ITEMDA,0)),"^",13)="y":1,1:0)

 ;

 ;

SUBACCT(ITEMDA) ;  return subacct of item

 Q $P($G(^PRC(441,+ITEMDA,0)),"^",10)

 ;

 ;

MANDSRCE(ITEMDA)   ;  return mandatory source for item

 Q $P($G(^PRC(441,+ITEMDA,0)),"^",8)

 ;

 ;

INACTIVE(ITEMDA)   ;  return 1 if item is inactive

 Q +$P($G(^PRC(441,+ITEMDA,3)),"^")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPU441   707     printed  Apr 09, 2024@21:12:02                                                                                                                                                                                                     Page 2

PRCPU441  ;WISC/RFJ-master item file utilities                       ;10 Feb 91

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

PURCHASE(ITEMDA) ;  return 1 if item is purchasable

 +1        QUIT $SELECT($PIECE($GET(^PRC(441,+ITEMDA,0)),"^",6)'="S":1,1:0)

 +2       ;

 +3       ;

REUSABLE(ITEMDA) ;  return if item is resuable or disposable

 +1        QUIT $SELECT($PIECE($GET(^PRC(441,+ITEMDA,0)),"^",13)="y":1,1:0)

 +2       ;

 +3       ;

SUBACCT(ITEMDA) ;  return subacct of item

 +1        QUIT $PIECE($GET(^PRC(441,+ITEMDA,0)),"^",10)

 +2       ;

 +3       ;

MANDSRCE(ITEMDA) ;  return mandatory source for item

 +1        QUIT $PIECE($GET(^PRC(441,+ITEMDA,0)),"^",8)

 +2       ;

 +3       ;

INACTIVE(ITEMDA) ;  return 1 if item is inactive

 +1        QUIT +$PIECE($GET(^PRC(441,+ITEMDA,3)),"^")