83 lines
2.5 KiB
Mathematica
83 lines
2.5 KiB
Mathematica
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
|