PRCHE1A ;WISC/DJM-IFCAP EDIT VENDOR FILE ;4/17/96 3:18 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
; NEW ENTER/EDIT VENDOR FILE CALLED FROM FISCAL OPTION
VEDIT(Y,SITE) ;
N DA,PRCHV3,FLAG,FISCAL,DIE,DR
S DA=+Y D Q:FLAG=0
.S PRCHV3=$G(^PRC(440,DA,3)),FLAG=0
.I $P(PRCHV3,U,4)="" S FLAG=1 Q ;NO FMS VENDOR CODE - DO 'ADD' VENDOR REQUEST
.I $P(PRCHV3,U,4)]"" S FLAG=2 Q ;FMS VENDOR CODE - DO 'CHANGE' VENDOR REQUEST
S FISCAL=$G(^PRC(411,SITE,9))
I $P(FISCAL,U,3)="Y",'$D(^XUSEC("PRCFA VENDOR EDIT",DUZ)) D Q
. Q:$$NEW^PRCOVTST(DA,SITE,FLAG)
. S DIE="^PRC(440.3,"
. S DR="47///^S X=FLAG;48///^S X=DA;49///^S X=SITE"
. D ^DIE
. Q
I FLAG=1 D NEW^PRCOVRQ(DA,SITE) QUIT
I FLAG=2 D UPDATE^PRCOVRQ1(DA,SITE) QUIT
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHE1A 812 printed Dec 13, 2024@02:07:03 Page 2
PRCHE1A ;WISC/DJM-IFCAP EDIT VENDOR FILE ;4/17/96 3:18 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ; NEW ENTER/EDIT VENDOR FILE CALLED FROM FISCAL OPTION
VEDIT(Y,SITE) ;
+1 NEW DA,PRCHV3,FLAG,FISCAL,DIE,DR
+2 SET DA=+Y
Begin DoDot:1
+3 SET PRCHV3=$GET(^PRC(440,DA,3))
SET FLAG=0
+4 ;NO FMS VENDOR CODE - DO 'ADD' VENDOR REQUEST
IF $PIECE(PRCHV3,U,4)=""
SET FLAG=1
QUIT
+5 ;FMS VENDOR CODE - DO 'CHANGE' VENDOR REQUEST
IF $PIECE(PRCHV3,U,4)]""
SET FLAG=2
QUIT
End DoDot:1
if FLAG=0
QUIT
+6 SET FISCAL=$GET(^PRC(411,SITE,9))
+7 IF $PIECE(FISCAL,U,3)="Y"
IF '$DATA(^XUSEC("PRCFA VENDOR EDIT",DUZ))
Begin DoDot:1
+8 if $$NEW^PRCOVTST(DA,SITE,FLAG)
QUIT
+9 SET DIE="^PRC(440.3,"
+10 SET DR="47///^S X=FLAG;48///^S X=DA;49///^S X=SITE"
+11 DO ^DIE
+12 QUIT
End DoDot:1
QUIT
+13 IF FLAG=1
DO NEW^PRCOVRQ(DA,SITE)
QUIT
+14 IF FLAG=2
DO UPDATE^PRCOVRQ1(DA,SITE)
QUIT
+15 QUIT
+16 ;
