PRCPUX1 ;WISC/RFJ/DGL/DWA-extrinsic functions ; 7/22/99 3:08pm
;;5.1;IFCAP;**17**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
UNIT(INVPT,ITEMDA,DELIM) ; unit per issue for inventory point and item
; if delim delimiter : pkgmult delim units (1 per EA)
N D,Y
S D=$G(^PRCP(445,+INVPT,1,+ITEMDA,0)),Y=$S($P(D,"^",14):$P(D,"^",14),1:"?")_"/"_$$UNITCODE($P(D,"^",5))
I $G(DELIM)'="" S Y=$P(Y,"/")_DELIM_$P(Y,"/",2)
Q Y
;
;
UNITVAL(PKGMULT,UNITS,DELIM) ; unit per issue for values passed as follows:
N Y
S Y=$S(PKGMULT:PKGMULT,1:"?")_"/"_$$UNITCODE(UNITS)
I $G(DELIM)'="" S Y=$P(Y,"/")_DELIM_$P(Y,"/",2)
Q Y
;
;
SKU(INVPT,ITEMDA) ; get the sku for an item in the item master file
N %
S %=$$UNITCODE($P($G(^PRC(441,+ITEMDA,3)),"^",8)) I %["?" S %=$$UNITCODE($P($G(^PRCP(445,+INVPT,1,+ITEMDA,0)),"^",5))
Q %
;
;
UNITCODE(UNITS) ; get 2 character unit code from file 420.5
N % S %=$P($G(^PRCD(420.5,+UNITS,0)),"^") S:%="" %="??"
Q %
;
;
NSN(ITEMDA) ; return nsn for itemda
Q $P($G(^PRC(441,+ITEMDA,0)),"^",5)
;
;
FSC(ITEMDA) ; return FSC as NSN for a given ITEMDA
Q $P($G(^PRC(441,+ITEMDA,0)),"^",3)
;
;
ACCT(NSN) ; return account code for nsn (first 4 digits)
I $G(DT)="" Q 8
Q $S(DT>2971000:8,NSN=6505!(NSN=6508):1,$E(NSN,1,2)=65!($E(NSN,1,2)=66):2,NSN=8975:3,$E(NSN,1,2)=89:8,$E(NSN,1,2)=91:6,1:3)
;
;
ACCT1(NSN) ; return account code for nsn for GIP
Q $S(NSN=6505!(NSN=6508):1,$E(NSN,1,2)=65!($E(NSN,1,2)=66):2,NSN=8975:3,$E(NSN,1,2)=89:8,$E(NSN,1,2)=91:6,1:3)
;
;
FOOD(ITEMDA) ; return food group for itemda
Q $P($G(^PRC(441,ITEMDA,3)),"^",7)
;
;
DESCR(INVPT,ITEMDA) ; description from inventory point or item master file
N Y
S Y=$P($G(^PRCP(445,+INVPT,1,+ITEMDA,6)),"^") I Y="" S Y=$P($G(^PRC(441,+ITEMDA,0)),"^",2)
Q Y
;
;
INVNAME(INVPT) ; inventory point name for inventory point
Q $P($G(^PRCP(445,+INVPT,0)),"^")
;
;
FCPDA(SITE,INVPT) ; returns fund control point da number for site and invpt
N Y
S Y=$P($G(^PRC(420,+SITE,1,+$O(^PRC(420,"AE",+SITE,+INVPT,0)),0))," ") I Y'="" S Y=SITE_Y ; Multiple FCP not supported
Q Y
;
;
VENNAME(VENDA) ; return vendor name for da;global (445 or 440)
I VENDA["PRC(440" Q $P($G(^PRC(440,+VENDA,0)),"^")
I VENDA["PRCP(445" Q $$INVNAME(+VENDA)
Q ""
;
;
VENDOR(INVPT,ITEMDA) ; return vendor number or name
N TYPE,X,Y
S TYPE=$P($G(^PRCP(445,INVPT,0)),"^",3),X=$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",12),Y=""
I TYPE="W" S Y=+X
I TYPE="P" S Y=$S(X["440":+X,1:"WHSE")
I TYPE="S" S Y=$P($$INVNAME(+X),"-",2,99)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUX1 2647 printed Dec 13, 2024@02:16:32 Page 2
PRCPUX1 ;WISC/RFJ/DGL/DWA-extrinsic functions ; 7/22/99 3:08pm
+1 ;;5.1;IFCAP;**17**;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
UNIT(INVPT,ITEMDA,DELIM) ; unit per issue for inventory point and item
+1 ; if delim delimiter : pkgmult delim units (1 per EA)
+2 NEW D,Y
+3 SET D=$GET(^PRCP(445,+INVPT,1,+ITEMDA,0))
SET Y=$SELECT($PIECE(D,"^",14):$PIECE(D,"^",14),1:"?")_"/"_$$UNITCODE($PIECE(D,"^",5))
+4 IF $GET(DELIM)'=""
SET Y=$PIECE(Y,"/")_DELIM_$PIECE(Y,"/",2)
+5 QUIT Y
+6 ;
+7 ;
UNITVAL(PKGMULT,UNITS,DELIM) ; unit per issue for values passed as follows:
+1 NEW Y
+2 SET Y=$SELECT(PKGMULT:PKGMULT,1:"?")_"/"_$$UNITCODE(UNITS)
+3 IF $GET(DELIM)'=""
SET Y=$PIECE(Y,"/")_DELIM_$PIECE(Y,"/",2)
+4 QUIT Y
+5 ;
+6 ;
SKU(INVPT,ITEMDA) ; get the sku for an item in the item master file
+1 NEW %
+2 SET %=$$UNITCODE($PIECE($GET(^PRC(441,+ITEMDA,3)),"^",8))
IF %["?"
SET %=$$UNITCODE($PIECE($GET(^PRCP(445,+INVPT,1,+ITEMDA,0)),"^",5))
+3 QUIT %
+4 ;
+5 ;
UNITCODE(UNITS) ; get 2 character unit code from file 420.5
+1 NEW %
SET %=$PIECE($GET(^PRCD(420.5,+UNITS,0)),"^")
if %=""
SET %="??"
+2 QUIT %
+3 ;
+4 ;
NSN(ITEMDA) ; return nsn for itemda
+1 QUIT $PIECE($GET(^PRC(441,+ITEMDA,0)),"^",5)
+2 ;
+3 ;
FSC(ITEMDA) ; return FSC as NSN for a given ITEMDA
+1 QUIT $PIECE($GET(^PRC(441,+ITEMDA,0)),"^",3)
+2 ;
+3 ;
ACCT(NSN) ; return account code for nsn (first 4 digits)
+1 IF $GET(DT)=""
QUIT 8
+2 QUIT $SELECT(DT>2971000:8,NSN=6505!(NSN=6508):1,$EXTRACT(NSN,1,2)=65!($EXTRACT(NSN,1,2)=66):2,NSN=8975:3,$EXTRACT(NSN,1,2)=89:8,$EXTRACT(NSN,1,2)=91:6,1:3)
+3 ;
+4 ;
ACCT1(NSN) ; return account code for nsn for GIP
+1 QUIT $SELECT(NSN=6505!(NSN=6508):1,$EXTRACT(NSN,1,2)=65!($EXTRACT(NSN,1,2)=66):2,NSN=8975:3,$EXTRACT(NSN,1,2)=89:8,$EXTRACT(NSN,1,2)=91:6,1:3)
+2 ;
+3 ;
FOOD(ITEMDA) ; return food group for itemda
+1 QUIT $PIECE($GET(^PRC(441,ITEMDA,3)),"^",7)
+2 ;
+3 ;
DESCR(INVPT,ITEMDA) ; description from inventory point or item master file
+1 NEW Y
+2 SET Y=$PIECE($GET(^PRCP(445,+INVPT,1,+ITEMDA,6)),"^")
IF Y=""
SET Y=$PIECE($GET(^PRC(441,+ITEMDA,0)),"^",2)
+3 QUIT Y
+4 ;
+5 ;
INVNAME(INVPT) ; inventory point name for inventory point
+1 QUIT $PIECE($GET(^PRCP(445,+INVPT,0)),"^")
+2 ;
+3 ;
FCPDA(SITE,INVPT) ; returns fund control point da number for site and invpt
+1 NEW Y
+2 ; Multiple FCP not supported
SET Y=$PIECE($GET(^PRC(420,+SITE,1,+$ORDER(^PRC(420,"AE",+SITE,+INVPT,0)),0))," ")
IF Y'=""
SET Y=SITE_Y
+3 QUIT Y
+4 ;
+5 ;
VENNAME(VENDA) ; return vendor name for da;global (445 or 440)
+1 IF VENDA["PRC(440"
QUIT $PIECE($GET(^PRC(440,+VENDA,0)),"^")
+2 IF VENDA["PRCP(445"
QUIT $$INVNAME(+VENDA)
+3 QUIT ""
+4 ;
+5 ;
VENDOR(INVPT,ITEMDA) ; return vendor number or name
+1 NEW TYPE,X,Y
+2 SET TYPE=$PIECE($GET(^PRCP(445,INVPT,0)),"^",3)
SET X=$PIECE($GET(^PRCP(445,INVPT,1,ITEMDA,0)),"^",12)
SET Y=""
+3 IF TYPE="W"
SET Y=+X
+4 IF TYPE="P"
SET Y=$SELECT(X["440":+X,1:"WHSE")
+5 IF TYPE="S"
SET Y=$PIECE($$INVNAME(+X),"-",2,99)
+6 QUIT Y
