48 lines
1.6 KiB
Mathematica
48 lines
1.6 KiB
Mathematica
PRCPUVEN ;WISC/RFJ-add,update,delete procurement sources ;06 Oct 91
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
ADDVEN(INVPT,ITEMDA,VENDOR,UNITREC,PKGMULT,CONVFACT) ; add procurement source
|
|
; vendor=vendorda;prc(440,
|
|
; vendor will be added if its not already there.
|
|
; data will be updated if not null.
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
|
|
N %,DATA,X,Y
|
|
S Y=$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0))
|
|
I 'Y D
|
|
. N DA,DIC,D0,DD,DLAYGO,DINUM,X
|
|
. S:'$D(^PRCP(445,INVPT,1,ITEMDA,5,0)) ^(0)="^445.07IV^^"
|
|
. S DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",X=VENDOR,DA(1)=ITEMDA,DA(2)=INVPT,DIC(0)="L",DLAYGO=445
|
|
. D FILE^DICN
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)) Q
|
|
L +^PRCP(445,INVPT,1,ITEMDA,5,+Y)
|
|
S DATA=^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)
|
|
I UNITREC S $P(DATA,"^",2)=UNITREC
|
|
I PKGMULT S $P(DATA,"^",3)=PKGMULT
|
|
I CONVFACT S $P(DATA,"^",4)=CONVFACT
|
|
S ^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)=DATA
|
|
L -^PRCP(445,INVPT,1,ITEMDA,5,+Y)
|
|
Q
|
|
;
|
|
;
|
|
DELVEN(INVPT,ITEMDA,VENDORDA) ; delete procurement sources
|
|
; vendorda=entryda for procurement source
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,5,VENDORDA,0)) Q
|
|
N %,DA,DIC,DIK,X,Y
|
|
S DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",DA=VENDORDA,DA(1)=ITEMDA,DA(2)=INVPT
|
|
D ^DIK
|
|
Q
|
|
;
|
|
;
|
|
GETVEN(INVPT,ITEMDA,VENDOR,CONVFACT) ; get procurement source data
|
|
; vendor=vendor;prcp(445 or vendor;prc(440
|
|
; if 'conv factor, convfact=convfact passed
|
|
; returns procsource^unitrec^pkgmult^conv^entryda
|
|
S %=+$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0)),Y=$G(^PRCP(445,INVPT,1,ITEMDA,5,%,0))
|
|
I CONVFACT S:'$P(Y,"^",4) $P(Y,"^",4)=CONVFACT
|
|
I 'Y Q Y
|
|
S $P(Y,"^",5)=%
|
|
Q Y
|