| [613] | 1 | PRCPUSA ;WISC/RFJ-utility program for updating inventory point ;30 Sep 92
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S X=$$UPDATE(.PRCP) I X'="" W !!,X Q
|
|---|
| 5 | K PRCP,X Q
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | UPDATE(PRCPZ) ; start updating inventory point
|
|---|
| 9 | ;prcpz =
|
|---|
| 10 | ; i) = internal inventory point number
|
|---|
| 11 | ; item) = item number
|
|---|
| 12 | ; typ) = R or C for distribution
|
|---|
| 13 | ; = RC for receipts
|
|---|
| 14 | ; = U for usage
|
|---|
| 15 | ; = A for adjustment
|
|---|
| 16 | ; = P for physical counts
|
|---|
| 17 | ; qty) = quantity to add to on-hand
|
|---|
| 18 | ; com) = transaction register comments
|
|---|
| 19 | ; returns error message if unsuccessful or null if successful
|
|---|
| 20 | ;
|
|---|
| 21 | I '$D(^PRCP(445,+$G(PRCPZ("I")),0)) Q "Invalid inventory location"
|
|---|
| 22 | I '$D(^PRCP(445,PRCPZ("I"),4,+$G(DUZ),0)) Q "User does not have access to the inventory point"
|
|---|
| 23 | I '$D(^PRCP(445,PRCPZ("I"),1,+$G(PRCPZ("ITEM")),0)) Q "Item is not stored in inventory point"
|
|---|
| 24 | S:'$D(PRCPZ("TYP")) PRCPZ("TYP")="" I "RCAUP"'[PRCPZ("TYP") Q "Invalid transaction type '"_PRCPZ("TYP")_"'"
|
|---|
| 25 | S:'$D(PRCPZ("QTY")) PRCPZ("QTY")=0 I "AP"'[PRCPZ("TYP"),PRCPZ("QTY")=0 Q "Quantity cannot equal zero"
|
|---|
| 26 | I PRCPZ("TYP")="RC",PRCPZ("QTY")<0 Q "For receipts, quantity must be greater than zero"
|
|---|
| 27 | I (PRCPZ("TYP")="R"!(PRCPZ("TYP")="C"))&(PRCPZ("QTY")>0) Q "For distribution (Regular or Call-in), quantity must be less than zero"
|
|---|
| 28 | ;
|
|---|
| 29 | N ORDERNO,PRCPID,PRCPUSA,TOTCOST,VALUE,X,Y,Z
|
|---|
| 30 | S VALUE=$P(^PRCP(445,PRCPZ("I"),1,PRCPZ("ITEM"),0),"^",22),TOTCOST=$J(PRCPZ("QTY")*VALUE,0,2)
|
|---|
| 31 | ;
|
|---|
| 32 | I $P(^PRCP(445,PRCPZ("I"),0),"^",6)="Y" S ORDERNO=$$ORDERNO^PRCPUTRX(PRCPZ("I"))
|
|---|
| 33 | K PRCPUSA S PRCPUSA("QTY")=PRCPZ("QTY"),PRCPUSA("INVVAL")=TOTCOST,PRCPUSA("SELVAL")=TOTCOST,PRCPUSA("REASON")="0:"_$G(PRCPZ("COM")),PRCPUSA("NODUEIN")=1,PRCPUSA("NODUEOUT")=1,PRCPUSA("OTHERPT")=""
|
|---|
| 34 | D ITEM^PRCPUUIP(PRCPZ("I"),PRCPZ("ITEM"),PRCPZ("TYP"),+$G(ORDERNO),.PRCPUSA)
|
|---|
| 35 | Q ""
|
|---|
