PRCHVEND.m

PRCHVEND ;MNTSS/RGB-VENDOR LOOKUP/DISPLAY ; 12 Dec 2014  10:18 AM

V ;;5.1;IFCAP;**190**;Oct 20, 2000;Build 3

 ;Per VA Directive 6402, this routine should not be modified.

 ;

 ;PRC*5.1*190 Create routine to handle option PRCH DISPLAY VENDOR

 ;to replace DIC/DIQ option control to now allow the correct format

 ;for DUN & BRADSTREET lookup

 ;

EN ;Lookup

 K DA,X,Y,DIR,DIC,DIQ

1 S DIR(0)="PO^440:EMZ",DIR("?")="*** DUN & BRADSTREET # MUST be preceded by 'DUN' ***" D ^DIR G EXIT:Y'>0 S:+Y>0 (X,DA)=+Y

 S DIC="^PRC(440,",DIQ(0)="IE"

 D EN^DIQ W !!

 G 1

EXIT K DA,X,Y,DIR,DIC,DIQ

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHVEND   590     printed  Apr 09, 2024@21:02:15                                                                                                                                                                                                     Page 2

PRCHVEND  ;MNTSS/RGB-VENDOR LOOKUP/DISPLAY ; 12 Dec 2014  10:18 AM

V         ;;5.1;IFCAP;**190**;Oct 20, 2000;Build 3

 +1       ;Per VA Directive 6402, this routine should not be modified.

 +2       ;

 +3       ;PRC*5.1*190 Create routine to handle option PRCH DISPLAY VENDOR

 +4       ;to replace DIC/DIQ option control to now allow the correct format

 +5       ;for DUN & BRADSTREET lookup

 +6       ;

EN        ;Lookup

 +1        KILL DA,X,Y,DIR,DIC,DIQ

1          SET DIR(0)="PO^440:EMZ"

           SET DIR("?")="*** DUN & BRADSTREET # MUST be preceded by 'DUN' ***"

           DO ^DIR

           if Y'>0

               GOTO EXIT

           if +Y>0

               SET (X,DA)=+Y

 +1        SET DIC="^PRC(440,"

           SET DIQ(0)="IE"

 +2        DO EN^DIQ

           WRITE !!

 +3        GOTO 1

EXIT       KILL DA,X,Y,DIR,DIC,DIQ