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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUTRA 3172 printed Nov 22, 2024@17:26:31 Page 2
PRCPUTRA ;WISC/RFJ-outstanding transaction and duein update ;20 Sep 91
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
ADDTRAN(INVPT,ITEMDA,TRANDA,PRCPDATA) ; create outstanding transacation duein
+1 ; PRCPDATA=qtyordered^unitofreceipt^pkgmult^convfact
+2 IF '+PRCPDATA
QUIT
+3 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,0))
QUIT
+4 IF $DATA(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA))
QUIT
+5 NEW %,D0,DA,DATA,DD,DIC,DINUM,DLAYGO,X,Y
+6 if '$DATA(^PRCP(445,INVPT,1,ITEMDA,7,0))
SET ^(0)="^445.09P^^"
+7 SET DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",7,"
SET (X,DINUM)=TRANDA
SET DA(1)=ITEMDA
SET DA(2)=INVPT
SET DIC(0)="L"
SET DLAYGO=445
+8 DO FILE^DICN
if Y<1
QUIT
+9 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0))
QUIT
+10 LOCK +^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)
+11 SET ^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)=^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)_"^"_PRCPDATA
+12 DO SETIN^PRCPUDUE(INVPT,ITEMDA,+PRCPDATA)
+13 LOCK -^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)
+14 QUIT
+15 ;
+16 ;
KILLTRAN(INVPT,ITEMDA,TRANDA) ; kill outstanding transaction
+1 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0))
QUIT
+2 NEW %,DIK,DA,DIC,QTY,X,Y
+3 SET QTY=$PIECE(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),"^",2)
+4 IF QTY
DO SETIN^PRCPUDUE(INVPT,ITEMDA,-QTY)
+5 SET DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",7,"
SET DA=TRANDA
SET DA(1)=ITEMDA
SET DA(2)=INVPT
+6 DO ^DIK
+7 QUIT
+8 ;
+9 ;
OUTST(INVPT,ITEMDA,TRANDA,QTY) ; add qty to outstanding transaction,
+1 ; update duein
+2 IF 'QTY
QUIT
+3 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0))
QUIT
+4 NEW %,DATA,NEWQTY
+5 SET DATA=^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)
SET NEWQTY=$PIECE(DATA,"^",2)+QTY
+6 IF NEWQTY<0
SET NEWQTY=0
SET QTY=-$PIECE(DATA,"^",2)
+7 SET $PIECE(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),"^",2)=NEWQTY
+8 IF QTY
DO SETIN^PRCPUDUE(INVPT,ITEMDA,QTY)
+9 ; kill transaction if duein is zero
+10 IF NEWQTY=0
DO KILLTRAN(INVPT,ITEMDA,TRANDA)
+11 QUIT
+12 ;
+13 ;
ADDUPD(INVPT,ITEMDA,TRANDA,PRCPDATA) ; create outstanding transacation duein
+1 ; prcpdata=qtyordered^unitofreceipt^pkgmult^convfact
+2 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,0))
QUIT
+3 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0))
DO ADDTRAN(INVPT,ITEMDA,TRANDA,PRCPDATA)
QUIT
+4 DO OUTST(INVPT,ITEMDA,TRANDA,$PIECE(PRCPDATA,"^"))
+5 QUIT
+6 ;
+7 ;
CHECKOUT(INVPT,ITEMDA,TRANDA) ; check outstanding transaction
+1 ; returns => outstdata=vendor^pkgmult^unitreceipt^convfactor
+2 ; => outsterr=error message
+3 ; if outstdata and outsterr not defined, outstanding transaction is correct
+4 KILL OUTSTERR,OUTSDATA
+5 NEW %,OUTST,V,VENDATA,VENDOR
+6 SET OUTST=$GET(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0))
+7 IF OUTST=""
SET OUTSTERR="OUTSTANDING TRANSACTION NOT FOUND IN INVENTORY POINT."
QUIT
+8 SET VENDOR=$PIECE($GET(^PRCS(410,TRANDA,3)),"^",4)
+9 IF 'VENDOR
SET OUTSTERR="VENDOR NOT SPECIFIED FOR OUTSTANDING TRANSACTION (FILE 441, FIELD 12)."
QUIT
+10 SET VENDATA=$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDOR_";PRC(440,",0)
+11 IF 'VENDATA
SET OUTSTERR="VENDOR NOT INCLUDED AS A PROCUREMENT SOURCE FOR THIS ITEM."
QUIT
+12 SET %=$$UNITVAL^PRCPUX1($PIECE(VENDATA,"^",3),$PIECE(VENDATA,"^",2)," per ")
+13 IF %["?"
SET OUTSTERR="PROCUREMENT SOURCE'S UNIT per RECEIPT ("_%_") IS INCORRECT."
QUIT
+14 IF '$PIECE(VENDATA,"^",4)
SET OUTSTERR="PROCUREMENT SOURCE'S CONVERSION FACTOR IS NOT DEFINED."
QUIT
+15 IF $PIECE(OUTST,"^",3,5)=$PIECE(VENDATA,"^",2,4)
QUIT
+16 SET OUTSDATA=VENDOR_"^"_$PIECE(VENDATA,"^",3)_"^"_$PIECE(VENDATA,"^",2)_"^"_$PIECE(VENDATA,"^",4)
+17 QUIT
