source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFAV.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1PRCFAV ;WISC@ALTOONA/CTB-ROUTINE TO PROCESS ADJUSTMENT VOUCHERS ;4/30/93 2:48 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCFSITE Q:'%
5 K FAIL D ES I $D(FAIL) K FAIL G OUT1
6 K DIC("A") S D="C",DIC("S")="I +$P(^(0),U)=PRC(""SITE"")",DIC("A")="Select Purchase Order Number: ",DIC=442,DIC(0)="AEQZ"
7 D IX^DIC K DIC("S"),DIC("A") G:+Y<0 OUT1
8 S PO(0)=Y(0),PO=Y,PRCFPODA=+Y,PRCFA("PODA")=+Y
9 I '$D(^PRC(442,+PO,6)) D NOA G OUT1
10 I $P(^PRC(442,+PO,6,0),"^",4)<0 D NOA G OUT1
11 S DIC="^PRC(442,"_+PO_",6,",DIC("A")="Select ADJUSTMENT VOUCHER",DIC(0)="AEMNZQ" D ^DIC K DIC("A") G:Y<0 OUT1 S PO(6)=Y(0),PO(6,1)=^PRC(442,+PO,6,+Y,1),PRCFA("AV")=+Y
12 I $P(PO(6,1),"^",5)'="" S %A="This Adjustment Voucher has already been processed by Fiscal,",%A(1)="ARE YOU SURE YOU WISH TO CONTINUE",%B="",%=2 D ^PRCFYN I %'=1 G OUT1
13 W ! S %A="Do you need to process a code sheet for this Adjustment Voucher",%B="",%=1 D ^PRCFYN Q:%<1 G:%=2 OUT D AM^PRCFAC
14AGAIN S PRCFA("PODA")=PRCFPODA W ! S %A="Do you need to enter an additional code sheet",%B="",%=2 D ^PRCFYN I %'=1 G OUT D AM^PRCFAC G AGAIN
15OUT ;D Q15 S $P(^PRC(442,PRCFA("PODA"),6,PRCFA("AV"),1),"^",5)=+PRC("PER"),$P(^(1),"^",6)=X
16 S $P(^PRC(442,PRCFA("PODA"),6,PRCFA("AV"),1),"^",5)=+PRC("PER") D Q15
17 S PRCHQ="^PRCHPAM",PRCHQ("DEST")="S8",D0=PRCFA("PODA"),D1=PRCFA("AV") D ^PRCHQUE
18OUT1 K P,DIC,PRCFA,PRCFPODA Q
19 Q
20NOA W !,$C(7),"No Adjustment Vouchers are entered for this order, please check with Supply. ",!,?20,"Option is being aborted." R X:3 Q
21ES ;
22ES1 K FAIL
23 N MESSAGE S MESSAGE=""
24 D ESIG^PRCUESIG(DUZ,.MESSAGE)
25 G FAIL1:MESSAGE=-1!(MESSAGE=-2)!(MESSAGE=-3),FAIL:MESSAGE=0
26 Q
27FAIL S FAIL="" W $C(7)," SIGNATURE CODE FAILURE " R X:3 Q
28FAIL1 S FAIL="" Q
29Q15 S MESSAGE=""
30 D ENCODE^PRCHES7(PRCF("PODA"),PRCFA("AV"),DUZ,.MESSAGE)
31 K MESSAGE
32 Q
Note: See TracBrowser for help on using the repository browser.