[613] | 1 | PRCHE1A ;WISC/DJM-IFCAP EDIT VENDOR FILE ;4/17/96 3:18 PM
|
---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ; NEW ENTER/EDIT VENDOR FILE CALLED FROM FISCAL OPTION
|
---|
| 5 | VEDIT(Y,SITE) ;
|
---|
| 6 | N DA,PRCHV3,FLAG,FISCAL,DIE,DR
|
---|
| 7 | S DA=+Y D Q:FLAG=0
|
---|
| 8 | .S PRCHV3=$G(^PRC(440,DA,3)),FLAG=0
|
---|
| 9 | .I $P(PRCHV3,U,4)="" S FLAG=1 Q ;NO FMS VENDOR CODE - DO 'ADD' VENDOR REQUEST
|
---|
| 10 | .I $P(PRCHV3,U,4)]"" S FLAG=2 Q ;FMS VENDOR CODE - DO 'CHANGE' VENDOR REQUEST
|
---|
| 11 | S FISCAL=$G(^PRC(411,SITE,9))
|
---|
| 12 | I $P(FISCAL,U,3)="Y",'$D(^XUSEC("PRCFA VENDOR EDIT",DUZ)) D Q
|
---|
| 13 | . Q:$$NEW^PRCOVTST(DA,SITE,FLAG)
|
---|
| 14 | . S DIE="^PRC(440.3,"
|
---|
| 15 | . S DR="47///^S X=FLAG;48///^S X=DA;49///^S X=SITE"
|
---|
| 16 | . D ^DIE
|
---|
| 17 | . Q
|
---|
| 18 | I FLAG=1 D NEW^PRCOVRQ(DA,SITE) QUIT
|
---|
| 19 | I FLAG=2 D UPDATE^PRCOVRQ1(DA,SITE) QUIT
|
---|
| 20 | QUIT
|
---|
| 21 | ;
|
---|