| [613] | 1 | PRCHAM5 ;WISC/AKS,ID/RSD,SF-ISC/TKW-CONT. OF AMENDMENTS ;7-2-91/15:40
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ENUI ; UPDATE FIELDS ON ITEM FILE THAT WERE CHANGED THROUGH AMENDMENT
|
|---|
| 5 | W !! D W W %B,! F I=0:0 S I=$O(%B(I)) Q:'I W %B(I),!
|
|---|
| 6 | D YN^PRCFYN Q:%'=1 S I=0 D UPI Q
|
|---|
| 7 | UPI S I=$O(^PRC(442,PRCHPO,2,I)) Q:'I S Y=^(I,0) G:'$D(^PRC(441,+$P(Y,U,5),0)) UPI S Z=$O(^PRC(442,PRCHPO,2,I,1,0)) G:'$D(^(Z,0)) UPI I ^(0)'["*AMENDED*" G UPI
|
|---|
| 8 | S:$P(Y,U,13)'="" $P(^PRC(441,+$P(Y,U,5),0),U,5)=$P(Y,U,13)
|
|---|
| 9 | G:'$D(^PRC(441,+$P(Y,U,5),2,PRCHCV,0)) UPI S X=^(0)
|
|---|
| 10 | S:$P(Y,U,3)'="" $P(X,U,7)=$P(Y,U,3) S:$P(Y,U,12) $P(X,U,8)=$P(Y,U,12) S:$P(Y,U,9) $P(X,U,2)=$P(Y,U,9),$P(X,U,6)=DT S:$P(Y,U,6)'="" $P(X,U,4)=$P(Y,U,6)
|
|---|
| 11 | I $D(^PRC(442,PRCHPO,2,I,2)) S Z=$P(^(2),U,2) I Z]"",$D(^PRC(442,PRCHPO,1)) S $P(X,U,3)=$O(^PRC(440,+^(1),4,"B",Z,0)) S Z=$O(^PRC(440,PRCHCV,4,"B",Z,0)) I Z S $P(X,U,3)=Z
|
|---|
| 12 | S ^PRC(441,+$P(Y,U,5),2,PRCHCV,0)=X
|
|---|
| 13 | G UPI
|
|---|
| 14 | EN7 ;PROMPT PAYMENT EDIT
|
|---|
| 15 | S DIC="^PRC(442,PRCHPO,5,",DIC(0)="AEQZ" D ^DIC Q:Y<0 S PRCHP=Y,PRCHP0=Y(0),PRCHO=$P(Y(0),U,1)_"/"_$P(Y(0),U,2)
|
|---|
| 16 | S %X="^PRC(442,PRCHPO,5,+PRCHP,",%Y="^PRC(443.6,PRCHPO,5,+PRCHP," D %XY^%RCR S ^PRC(443.6,PRCHPO,5,0)="^443.66A^"_$P(^PRC(442,PRCHPO,5,0),U,3,4)
|
|---|
| 17 | S DR="[PRCHAMPPP]",DIE="^PRC(443.6,",DA=PRCHPO D ^DIE K DIE
|
|---|
| 18 | S PRCHN=$S($D(^PRC(443.6,PRCHPO,5,+PRCHP,0)):$P(^(0),U,1)_"/"_$P(^(0),U,2),1:"@") Q:PRCHO=PRCHN
|
|---|
| 19 | S PRCHT=0 S:PRCHN="@" PRCHL1="*",^TMP("PRCHW",$J,1)="Prompt Payment "_PRCHO_" has been cancelled" Q
|
|---|
| 20 | PONO I $D(PRCHNRQ) S PRCHP("A")="REQUISITION NUMBER",PRCHP("T")=8,PRCHP("S")=1 D EN^PRCHPAT Q
|
|---|
| 21 | I $D(PRCHIMP) S PRCHP("A")="IMPREST FUND P.O.NO.: ",PRCHP("T")=7,PRCHP("S")=3 D EN^PRCHPAT Q
|
|---|
| 22 | D ENPO^PRCHUTL Q
|
|---|
| 23 | DOCID S Z=$P(^PRC(443.6,PRCHPO,0),"-",2),$P(^PRC(443.6,PRCHPO,18),"^",3)=$S(Z:$E(Z,2,6),1:$E(Z)_$E(Z,3,6)) K Z Q
|
|---|
| 24 | W S %B="You have the choice to let the system automatically update the Item Master",%B(1)="File with the amended data. If you choose to do this, the following",%B(2)="fields will be updated for ALL amended items on this order:"
|
|---|
| 25 | S %B(3)=" National Stock No.",%B(6)=" Vendor Stock No.",%B(7)=" Unit of Purchase",%B(8)=" Packaging Multiple",%B(9)=" Actual Unit Cost",%B(10)=" Contract Number."
|
|---|
| 26 | S %A="UPDATE ITEM FILE",%=2
|
|---|
| 27 | Q
|
|---|
