PRCHE1A.m

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 ---PRCHE1A   812     printed  Apr 09, 2024@21:15:22                                                                                                                                                                                                      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      ;