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 ---[H[J[2J[HPRCPU441 707 printed Dec 13, 2024@02:16:04 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)),"^")
