74 lines
3.0 KiB
Mathematica
74 lines
3.0 KiB
Mathematica
PRCPUTRA ;WISC/RFJ-outstanding transaction and duein update ;20 Sep 91
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
ADDTRAN(INVPT,ITEMDA,TRANDA,PRCPDATA) ; create outstanding transacation duein
|
|
; PRCPDATA=qtyordered^unitofreceipt^pkgmult^convfact
|
|
I '+PRCPDATA Q
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
|
|
I $D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)) Q
|
|
N %,D0,DA,DATA,DD,DIC,DINUM,DLAYGO,X,Y
|
|
S:'$D(^PRCP(445,INVPT,1,ITEMDA,7,0)) ^(0)="^445.09P^^"
|
|
S DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",7,",(X,DINUM)=TRANDA,DA(1)=ITEMDA,DA(2)=INVPT,DIC(0)="L",DLAYGO=445
|
|
D FILE^DICN Q:Y<1
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) Q
|
|
L +^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)
|
|
S ^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)=^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)_"^"_PRCPDATA
|
|
D SETIN^PRCPUDUE(INVPT,ITEMDA,+PRCPDATA)
|
|
L -^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)
|
|
Q
|
|
;
|
|
;
|
|
KILLTRAN(INVPT,ITEMDA,TRANDA) ; kill outstanding transaction
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) Q
|
|
N %,DIK,DA,DIC,QTY,X,Y
|
|
S QTY=$P(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),"^",2)
|
|
I QTY D SETIN^PRCPUDUE(INVPT,ITEMDA,-QTY)
|
|
S DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",7,",DA=TRANDA,DA(1)=ITEMDA,DA(2)=INVPT
|
|
D ^DIK
|
|
Q
|
|
;
|
|
;
|
|
OUTST(INVPT,ITEMDA,TRANDA,QTY) ; add qty to outstanding transaction,
|
|
; update duein
|
|
I 'QTY Q
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) Q
|
|
N %,DATA,NEWQTY
|
|
S DATA=^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),NEWQTY=$P(DATA,"^",2)+QTY
|
|
I NEWQTY<0 S NEWQTY=0,QTY=-$P(DATA,"^",2)
|
|
S $P(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),"^",2)=NEWQTY
|
|
I QTY D SETIN^PRCPUDUE(INVPT,ITEMDA,QTY)
|
|
; kill transaction if duein is zero
|
|
I NEWQTY=0 D KILLTRAN(INVPT,ITEMDA,TRANDA)
|
|
Q
|
|
;
|
|
;
|
|
ADDUPD(INVPT,ITEMDA,TRANDA,PRCPDATA) ; create outstanding transacation duein
|
|
; prcpdata=qtyordered^unitofreceipt^pkgmult^convfact
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
|
|
I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) D ADDTRAN(INVPT,ITEMDA,TRANDA,PRCPDATA) Q
|
|
D OUTST(INVPT,ITEMDA,TRANDA,$P(PRCPDATA,"^"))
|
|
Q
|
|
;
|
|
;
|
|
CHECKOUT(INVPT,ITEMDA,TRANDA) ; check outstanding transaction
|
|
; returns => outstdata=vendor^pkgmult^unitreceipt^convfactor
|
|
; => outsterr=error message
|
|
; if outstdata and outsterr not defined, outstanding transaction is correct
|
|
K OUTSTERR,OUTSDATA
|
|
N %,OUTST,V,VENDATA,VENDOR
|
|
S OUTST=$G(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0))
|
|
I OUTST="" S OUTSTERR="OUTSTANDING TRANSACTION NOT FOUND IN INVENTORY POINT." Q
|
|
S VENDOR=$P($G(^PRCS(410,TRANDA,3)),"^",4)
|
|
I 'VENDOR S OUTSTERR="VENDOR NOT SPECIFIED FOR OUTSTANDING TRANSACTION (FILE 441, FIELD 12)." Q
|
|
S VENDATA=$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDOR_";PRC(440,",0)
|
|
I 'VENDATA S OUTSTERR="VENDOR NOT INCLUDED AS A PROCUREMENT SOURCE FOR THIS ITEM." Q
|
|
S %=$$UNITVAL^PRCPUX1($P(VENDATA,"^",3),$P(VENDATA,"^",2)," per ")
|
|
I %["?" S OUTSTERR="PROCUREMENT SOURCE'S UNIT per RECEIPT ("_%_") IS INCORRECT." Q
|
|
I '$P(VENDATA,"^",4) S OUTSTERR="PROCUREMENT SOURCE'S CONVERSION FACTOR IS NOT DEFINED." Q
|
|
I $P(OUTST,"^",3,5)=$P(VENDATA,"^",2,4) Q
|
|
S OUTSDATA=VENDOR_"^"_$P(VENDATA,"^",3)_"^"_$P(VENDATA,"^",2)_"^"_$P(VENDATA,"^",4)
|
|
Q
|