source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHESE.m@ 1582

Last change on this file since 1582 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1PRCHESE ;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
5EN 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
13ASK 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
18DIE S DIE="^PRC(443.6,",DA=PRCHPO D ^DIE K DIE Q
19Q QUIT
Note: See TracBrowser for help on using the repository browser.