- 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 Mar 13, 2025@21:11:51 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 ;
