| [613] | 1 | PRCHESE ;WISC/AKS-Estimated Shipping Edit ;11/2/93 10:35
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S PRCF("X")="S" D ^PRCFSITE
|
|---|
| 5 | EN K PRCHP Q:'$D(PRC("SITE")) S PRCHP("S")="$P(^(0),U,2)<8" S:$D(PRCHNRQ) PRCHP("A")="REQUISITION NO.: ",PRCHP("S")="$P(^(0),U,2)=8"
|
|---|
| 6 | D EN3^PRCHPAT Q:'$D(PRCHPO) I X<20!(X=45) W $C(7)," ??" G EN
|
|---|
| 7 | I X=28!(X=33) W $C(7),!,"Amendments not allowed until after order has been Obligated!!" G EN
|
|---|
| 8 | D LCK^PRCHAM3 G:$T Q S PRCH(0)=Y(0),PRCH(1)=^PRC(442,PRCHPO,1),PRCH(7)=^(7),PRCH(12)=^(12),(PRCHAMT,PRCHAN,PRCHDL,PRCHAREC,PRCHCHK)=0
|
|---|
| 9 | I $D(^PRC(442,PRCHPO,6)) F I=0:0 S I=$O(^PRC(442,PRCHPO,6,I)) Q:'I S PRCHAN=I
|
|---|
| 10 | S PRCHAN=PRCHAN+1 W !?5,"Amendment number: ",PRCHAN S %=1,%A=" Do you wish to continue",%B="" D ^PRCFYN G:%'=1 Q
|
|---|
| 11 | S ^PRC(443.6,PRCHPO,0)=PRCH(0),^(1)=PRCH(1),^(7)=PRCH(7),^(12)=PRCH(12),DIE="^PRC(443.6,",DR="[PRCHAMEND]" S:$D(PRCHAV) DR="[PRCHAMENDAV]"
|
|---|
| 12 | D ^DIE G:$D(Y) Q I '$D(^PRC(443.6,PRCHPO,6,PRCHAN,1)) W !?5,"Can't continue without a Purchasing Agent !" G Q
|
|---|
| 13 | ASK K ^TMP("PRCHW",$J) S DIC="^PRCD(442.2,",DIC("S")="I Y>19,($P(^(0),U,3)]"""")" S:$D(PRCHNRQ) DIC("S")=DIC("S")_",(""25;26;28;35;36""'[Y)" S DIC(0)="QEAZ"
|
|---|
| 14 | D ^DIC G:Y<0 CHK^PRCHAM K DIC I '$D(^PRCD(442.2,+Y,1)) W !!?5,"Amendment Lines in file 442.2 not defined " G ASK
|
|---|
| 15 | S ROU=$P(Y(0),U,3),PRCHL1=$P(^PRCD(442.2,+Y,1),U,1),PRCHL2=$P(^(1),U,2) I $L($T(@ROU))<2 W !!?5,"Routine line not defined " G ASK
|
|---|
| 16 | S PRCHT=1 D @ROU G ASK:PRCHT D EN^PRCHAM G ASK
|
|---|
| 17 | ;S PRCHT=1 D @ROU S:'$D(PRCHT) PRCHT=1 G ASK:PRCHT D EN^PRCHAM G ASK
|
|---|
| 18 | DIE S DIE="^PRC(443.6,",DA=PRCHPO D ^DIE K DIE Q
|
|---|
| 19 | Q QUIT
|
|---|
