source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUTRA.m

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