Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPUTRA

PRCPUTRA.m

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