- 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 Jan 18, 2025@03:17:37 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