ACRFUFMU.m

ACRFUFMU ;IHS/OIRM/DSD/AEF - OPEN DOCUMENTS MATCH FROM CORE FOR UFMS [ 05/21/2007   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGMT SYSTEM;**22**;NOV 05, 2001

 ;  NEW ROUTINE ACR*2.1*22 UFMS

 ;

PIECE ;EP;

 I ACROCCDA]"" D

 .S ACROCC=$P($G(^AUTTOBJC(ACROCCDA,0)),U)

 I ACRCANDA]"" D

 .S ACRCAN=$P($G(^AUTTCAN(ACRCANDA,0)),U)

 Q

 ;

 ; ****************************

MATCH() ;EP;

 I ACRCCAN'=ACRCAN Q 0

 I ACRCOCC'=ACROCC Q 0

 I ACRCFY=ACRFY Q 1           ;MATCH

 I $E(ACRCFY,3,4)'=ACRFY Q 0  ;ACCOMODATE 2-DIGIT FY

 Q 1                          ;MATCH

 ;

 ; ****************************

MATCH2(ACRXX,I,ACRV) ;EP; FIND MATCH IN ARRAY

 ;

 I '$D(ACRXX(1,I)) Q 0               ;NOT A MATCH

 S ACRMATCH=$G(ACRXX(1,I,ACRV))      ;SEND BACK ITEM DA

 S:ACRMATCH="" ACRMATCH=$G(ACRXX(1,I,0))

 S:ACRMATCH="" ACRMATCH=0

 Q ACRMATCH

 ;

 ; ****************************

CKVEND(ACRV) ;EP; CHECK FOR MISSING VENDOR DATA

 ;

 ;    Enters with: ACRV = Vendor file IEN

 ;    Returns:  NULL or

 ;              Error string

 S ACRERR=""

 I $G(ACRCTYP)="TR"  Q ACRERR          ;DON'T WANT TRAVEL VENDORS

 S ACRCEIN=$G(ACRCEIN)

 S ACRCORE=$G(ACRCORE)

 S:'$D(ACR) ACR=0

 N ACRTEIN

 D NAMCHK(ACRV)

 D DUNSCHK(ACRV)

 D EINCHK(ACRV)                    ;CHECKS EIN,SUFFIX & DUPS

 I ACRCEIN]"",ACRCEIN'[11111111 D

 .S ACRTEIN=ACREIN_ACRSFX

 .I ACRCEIN'=ACRTEIN D

 ..S ^ACRZ("CEIN",ACR)=ACRCEIN_"/"_ACRTEIN_" NO MATCH"_U_ACRCORE  ;RECORD BAD MATCH

 ..S ACRERR=ACRERR_"CORE EIN "_ACRCEIN_" does not match IHS "_ACRTEIN_U

 D ADDCHK(ACRV)

 D BANK(ACRV)

 I $$IDATE(ACRV) D

 .S ACRERR="Inactive** "_U_ACRERR

 Q ACRERR

 ; ****************************

BANK(ACRV) ;EP; CHECK EFT BANKING INFORMATION

 ;

 ;    Enters with: ACRV = Vendor file IEN

 ;    Returns:  Error string

 N ACREFTT,ACRRT,ACRBANK

 S ACRBANK=$TR($G(^AUTTVNDR(ACRV,19)),U) ;REMOVES DELIMITERS

 I ACRBANK="" D  Q

 .S ACRERR=ACRERR_"No EFT"_U

 S ACREFTT=$$EFTAT(ACRV)                 ;ACCOUNT TYPE

 S ACRRT=$$EFTRT(ACRV)                   ;ROUTING NUMBER

 S ACRACNT=$$EFTDA(ACRV)                 ;ACCOUNT NUMBER

 I ACRACNT'?5.N D

 .D SETDATE(ACRV)

 .S ACRERR=ACRERR_"Bad Account Number "_ACRACNT_U

 I '$$RCK(ACRRT)!(ACRRT'?5.N) D

 .S ACRERR=ACRERR_"Bad Bank Routing Number "_ACRRT_U

 .D SETDATE(ACRV)

 I ACREFTT'="S",ACREFTT'="C" D

 .S ACRERR=ACRERR_"Missing/Bad Acct Type "_ACREFTT_U

 .D SETDATE(ACRV)

 Q

 ; ****************************

ADDCHK(ACRV) ;EP;  CHECK VENDOR MAILING ADDRESS ZIP

 ;

 ;    Enters with: ACRV = Vendor file IEN

 ;    Returns:  Error string

 ;

 N ACRZIP,ACRZIP2

 S ACRZIP=$$MZIP(ACRV)

 S ACRZIP2=$TR(ACRZIP,"-")

 I ACRZIP2'?9N D

 .S ACRERR=ACRERR_"Mailing ZIP "_ACRZIP_U

 Q

 ; ****************************

NAMCHK(ACRV) ;EP; CHECK VENDOR NAME AND INACTIVE STATUS

 ;

 ;    Enters with: ACRV = Vendor file IEN

 ;    Returns:  Error string

 ;              Inactive flag

 ;

 N ACRE1,ACRE2

 S ACRVNAM=$$VNAME(ACRV)

 I ACRVNAM="" D

 .S ACRERR="Vendor Name Missing"_U

 .D SETDATE(ACRV)

 S ACRE1=$E(ACRVNAM)

 S ACRE2=$E(ACRVNAM,1,2)

 I $E(ACRVNAM,1,6)?6N S ACRE1=" "                       ;FORCE ERROR MESSAGE

 I ACRE1?1L!($E(ACRVNAM,2)?1L) D UPPER(ACRV,ACRVNAM)    ;NO LOWER CASE

 I ACRVNAM["DO NOT USE"!(ACRVNAM["DON'T USE")!(ACRVNAM["DONT USE")!(ACRVNAM["NOT SPECIFIED") S ACRE1=" "

 I ACRE1=" "!(ACRE1=".")!(ACRE2="ZZ")!(ACRE2="XX")!(ACRE1="""")!(ACRE1="'")!(ACRE1=",") D

 .S ACRERR=ACRERR_"Bad Vendor Name "_ACRVNAM_U

 .D SETDATE(ACRV)

 Q

 ;

 ; ****************************

DUNSCHK(ACRV) ; EP - CHECK FOR DUNS

 ;

 ;    Enters with: ACRV = Vendor file IEN

 ;    Returns:  Error string

 ;

 N ACRDUN

 S ACRDUN=$$DUNS^ACRFVLK(ACRV)

 I ACRDUN[99999!(ACRDUN[11111)!(ACRDUN["00000") S ACRDUN="BAD"  ;FORCE ERROR

 I ACRDUN'?9N,ACRDUN'?13N D  ;MISSING OR WRONG LENGTH

 .S DA=ACRV

 .S DIE="^AUTTVNDR("

 .S DR=".07///^S X=""@"""

 .D ^DIE

 .S ACRERR=ACRERR_"DUNS missing"_U

 Q

 ;

 ; ****************************

EINCHK(ACRV) ;EP; CHECK EIN FOR VENDORS WITH THE SAME EIN NO

 ;

 ;    Enters with: ACRV = Vendor file IEN

 ;    Returns:  Error string

 ;    Enters with ACRNODUP if called outside of UFMS routines

 ;

 N ACREINP,ACRXEIN,ACRXIEN,Z,I

 S ACRSFX=""

 S ACREIN=$$EIN(ACRV)

 I ACREIN="" D  Q

 .S ACRERR=ACRERR_"EIN is Missing "_U

 .D SETDATE(ACRV)                         ;MAKE INACTIVE

 S Z=ACREIN

 I ACRERR["DUNS missing" D                ;CHECK FOR 5 SEQUENTIAL NUMBERS

 .I Z["00000" S Z="" Q

 .I Z[11111 S Z="" Q

 .I Z[22222 S Z="" Q

 .I Z[33333 S Z="" Q

 .I Z[44444 S Z="" Q

 .I Z[55555 S Z="" Q

 .I Z[66666 S Z="" Q

 .I Z[77777 S Z="" Q

 .I Z[88888 S Z="" Q

 .I Z[99999 S Z="" Q

 .I Z[101010 S Z="" Q

 I Z'?10N D

 .S ACRERR=ACRERR_"EIN has Bad Format "_ACREIN_U

 .D SETDATE(ACRV)                            ;MAKE INACTIVE

 S ACRSFX=$$SFX(ACRV)

 S ACREINP=$E(ACREIN)

 S ACRORG=$$ORG(ACRV)

 I ACRORG="" D ORGSET(ACRV)

 I ACRORG]"",ACRORG'=ACREINP D

 .S ACRERR=ACRERR_"EIN prefix does not match Org/Ind "_ACREINP_"/"_ACRORG_U

 .D SETDATE(ACRV)                            ;MAKE INACTIVE

 I ACREINP'=1,ACREINP'=2 D

 .S ACRERR=ACRERR_"Bad EIN prefix "_ACREINP_U

 .D SETDATE(ACRV)                            ;MAKE INACTIVE

 S ACRXEIN=""

 I '$D(ACRNODUP) F  S ACRXEIN=$O(^AUTTVNDR("E",ACRXEIN)) Q:ACRXEIN=""  D

 .Q:$E(ACRXEIN,1,10)'=ACREIN

 .S ACRXIEN=""

 .F  S ACRXIEN=$O(^AUTTVNDR("E",ACRXEIN,ACRXIEN)) Q:'ACRXIEN  D

 ..I ACRXIEN=ACRV Q                   ;DON'T COUNT SELF

 ..Q:ACRERR["Duplicate"               ;DON'T ADD MULTIPLE DUPS

 ..Q:$$IDATE(ACRXIEN)                 ;DON'T COUNT INACTIVE DUPS

 ..Q:'$$DUPCHK(ACRV,ACRXIEN)          ;QUIT IF NOT A DUPLICATE

 ..S ACRERR=ACRERR_"Duplicate EIN "_$$EIN(ACRXIEN)_"  "_$$SFX(ACRXIEN)_U

 I ACRSFX=""!(ACRSFX'?2UN) D          ;BAD SUFFIX -- ALL VENDORS

 .S ACRERR=ACRERR_"Missing or Bad Suffix "_ACRSFX_U

 Q

 ;

 ; ****************************

VNAME(X) ;EP     ;----- RETURNS NAME OF VENDOR

 ;

 ;      X  = VENDOR IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,0)),U)               ;FREE TEXT

 Q Y

 ;

 ; *********************************

IDATE(X) ;EP     ;----- RETURNS DATE INACTIVATED

 ;

 ;      X  = VENDOR IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,0)),U,5)               ;DT DATE

 Q Y

 ;

 ; ****************************

EIN(X) ;EP;    ;----- RETURNS EIN NO

 ;

 ;      X  = VENDOR FILE IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,11)),U)        ;FREE TEXT

 Q Y

 ;

 ; ****************************

SFX(X) ;EP;    ;----- RETURNS SUFFIX

 ;

 ;      X  = VENDOR FILE IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,11)),U,2)        ;FREE TEXT

 Q Y

 ;

 ; ****************************

MZIP(X) ;      ;----- RETURNS MAILING ADDRESS - ZIP

 ;

 ;      X  = VENDOR FILE IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,13)),U,4)              ;FREE TEXT

 Q Y

 ;

 ; ****************************

EFTAT(X) ;EP;----- RETURNS EFT ACCOUNT TYPE INFORMATION

 ;

 ;      X  = VENDOR FILE IEN

 ;

 ;RETURNS:

 ;       Y = NULL or

 ;       Y = CODE

 ;              C = CHECKING

 ;              S = SAVINGS

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,19)),U)

 Q Y

 ;

 ; ****************************

EFTRT(X) ;EP;    ;----- RETURNS EFT ROUTING TRANSIT NUMBER

 ;

 ;      X  = VENDOR FILE IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,19)),U,2)             ;FREE TEXT

 Q Y

 ;

 ; ****************************

EFTDA(X) ;EP;    ;----- RETURNS EFT DEPOSITOR ACCOUNT NUMBER

 ;

 ;      X  = VENDOR FILE IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,19)),U,3)             ;FREE TEXT

 Q Y

 ;

 ; ****************************

EFTSRT(X) ;EP;    ;----- RETURNS EFT SUB-ROUTING TRANSIT NUMBER

 ;

 ;      X  = VENDOR FILE IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,19)),U,4)             ;FREE TEXT

 Q Y

 ;

 ; ****************************

ORG(X) ;EP;    ;----- RETURNS INDIVIDUAL/ORGANIZATION INDICATOR

 ;

 ;      X  = VENDOR FILE IEN

 ;    RETURNS: 1 = ORGANIZATION

 ;             2 = INDIVIDUAL

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTVNDR(X,11)),U,19)

 Q Y

 ;

 ; ****************************

SETCK(ACRMSG,ACR) ;EP; ONLY ENTER NO MATCHES ONCE

 ;

 N I,J,QUIT,STR,HIT

 S (HIT,QUIT)=0

 F I="ACRDOC","NOVNDR","GTRIP","CHS","TR","GR","NOHIT" D  Q:QUIT

 .I $D(^ACRZ(I,ACR)) S HIT=1 I $D(^ACRZ("NOMATCH",ACR)) D

 ..K ^ACRZ("NOMATCH",ACR)

 ..S ACRMCNT=ACRMCNT-1

 ..S QUIT=1

 ;

 Q:QUIT

 I ACRCHS,$$OCC(ACRCOCC) D  Q:QUIT

 .I (ACRCFY-ACRFY)>2 D                         ;IGNORE OLD CHS DOCUMENTS

 ..D CHSSET^ACRFUFMZ(ACR)                      ;NO VALID MATCH, SET CHS FILE

 ..S QUIT=1

 I $D(^ACRZ("NOMATCH",ACR)) Q

 I 'HIT,ACRCTYP="TR" D  Q

 .Q:$D(^ACRZ("TR",ACR))

 .S ^ACRZ("TR",ACR)="NO MATCH TRAVEL"_U_U_U_U_ACRCORE

 .S ACRTRTOT=ACRTRTOT+1

 I 'HIT D

 .S ^ACRZ("NOMATCH",ACR)=ACRMSG_U_ACRSTR_U_ACRCORE  ;CAPTURE NOT MATCHED

 .S ACRMCNT=ACRMCNT+1

 I ACRV>0 D

 .Q:$D(^ACRZ("VNDR",ACRV))                 ;ALREADY IN FILE

 .S ACRERR=$$CKVEND^ACRFUFMU(ACRV)         ;CHECK FOR VENDOR ERRORS

 .S ACRSTR=ACRSTR_U_ACRCORE_U_U

 .D SETVND^ACRFUFMZ

 Q

 ;

 ; ****************************

VENDOR(ACR) ;EP; FIND VENDOR FROM PO,TRAINING OR TRAVEL (SSN FROM NEW PERSON)

 ;   ENTERS WITH FMS DOCUMENT IEN

 ;   RETURNS VENDOR FROM FMS DOCUMENT (PO OR TRAINING)

 ;

 N ACRV,V1,V2

 S ACRCTYP=$G(ACRCTYP)

 S ACRRTYP=$$REQTP^ACRFSSU(ACR)               ;GET REQUEST TYPE

 I ACRRTYP["CREDIT CARD" D  Q ACRV            ;QUIT IF DEF CC VENDOR

 .S ACRV=$$CCVEN                              ;DEFAULT CC VENDOR

 S ACRV=$P($G(^ACRDOC(ACR,"PO")),U,5)         ;PAYEE

 S:'ACRV ACRV=""

 I ACRV="",ACRRTYP["TRAINING" D

 .S ACRV=$P($G(^ACRDOC(ACR,"TRNG3")),U)       ;GET VENDOR FROM TRAINING NODE

 I ACRRTYP["TRAVEL" D                         ;TRAVELER

 .I ACRCTYP="AP" S ACRCTYP="TR"               ;TRAVEL DOC DISGUISED AS PO

 .S ACRV=$P($G(^ACRDOC(ACR,"TO")),U,9)        ;POINTER TO NEW PERSON FILE

 I ACRV="" S ACRV=$P($G(^ACRDOC(ACR,5)),U,5)  ;CONTRACTOR

 S:ACRV="" ACRV=0

 Q ACRV

 ;

 ; ****************************

RCK(ACRR) ;EXTRINSIC FUNCTION TO CHECKSUM THE EFT BANK ROUTING NUMBER

 ; ENTERS WITH THE ROUTING NUMBER = ACRR

 ;

 ; RETURNS 0 IF BAD

 ;         1 IF GOOD

 N ACRX

 S ACRX=$TR(ACRR," ")

 S ACRX=$TR(ACRX,"-")

 I $L(ACRX)'=9 Q 0                         ;BAD LENGTH

 N I,P,PP,ACRTOT8,ACRTOT9,ACRLAST

 S ACRTOT8=0

 F I=1:1:9 S P(I)=$E(ACRX,I)

 F I=1:3:7 S PP(I)=P(I)*3

 F I=2:3:8 S PP(I)=P(I)*7

 F I=3:3:9 S PP(I)=P(I)*1

 F I=1:1:8 S ACRTOT8=ACRTOT8+PP(I)

 S ACRTOT9=ACRTOT8+PP(9)

 I ACRTOT9#10'=0 Q 0                        ;NOT A MULTIPLE OF 10

 S ACRLAST=$E(ACRX,9)

 I ACRTOT8+ACRLAST'=ACRTOT9 Q 0             ;BAD CHECKSUM NUMBER

 Q 1

 ;

 ;*****************************

PRG(X) ;

 ;  X = DEPARTMENT ACCOUNT POINTER

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^AUTTPRG(X,0)),U)          ;PROGRAM NAME

 Q Y

 ;

 ;*****************************

DOL(X,Z) ;EP; EXTRINSIC FUNCTION TO RETURN 

 ;    X = DOLLAR AMOUNT IN 0000123456 FORMAT (FROM DHR)

 ;    Z = REVERSE CODE FROM TRANSACTION NUMBER

 N Y

 S Y=$FN((X/100),",",2)

 I Y]"",Z=2 S Y="-"_Y

 Q Y

 ;

 ;*****************************

VEN(X) ;EP;  EXTRINSIC FUNCTION TO FIND VENDOR THROUGH CROSS-REFERENCES

 ;    X = EIN FROM CORE

 ;    RETURNS VENDOR FILE POINTER OR 0

 ;

 I X["1111111"!(X="") Q 0              ;PSUEDO NUMBER

 N I,Y,Z,HIT

 S (Y,HIT)=0

 F I="C","D","E" D  Q:Y

 .Q:'$D(^AUTTVNDR(I,X))

 .S Y=$O(^AUTTVNDR(I,X,0))

 I Y Q Y                        ;FOUND A VENDOR

 I $D(^AUTTVNDR("C",$E(X,1,10))) D

 .S Y=$O(^AUTTVNDR("C",$E(X,1,10),0))

 I 'Y S Y=0

 Q Y

 ;

 ; ****************************

SETDATE(ACR) ;

 Q:$$IDATE(ACR)                 ;ALREADY INACTIVATED

 S DIE="^AUTTVNDR("

 S DA=ACR

 S DR=".05///"_DT

 D DIE^ACRFDIC

 Q

 ; ****************************

DUPCHK(ACRIEN,ACRXIEN) ;EP; CHECK EIN FOR VENDORS WITH THE SAME EIN NO

 ;  IF DIFFERENT BANK ACCOUNTS OR DUNS NOT A DUPLICATE

 ;    Enters with: ACRIEN = Vendor file IEN

 ;                 ACRXIEN = Possible duplicate IEN

 ;    Returns: 0 = not a duplicate

 ;             1 = is a duplicate

 ;

 I $D(ACRNODUP) Q 0                          ;ALLOW AUDIT ENTRY

 S ACRBNK=$TR($G(^AUTTVNDR(ACRIEN,19)),U)

 S ACRXBNK=$TR($G(^AUTTVNDR(ACRXIEN,19)),U)

 I ACRBNK]"",ACRXBNK]"",ACRBNK'=ACRXBNK Q 0  ;DIFFERENT BANK ACCOUNT

 S ACRDUN=$$DUNS^ACRFVLK(ACRIEN)

 S ACRXDUN=$$DUNS^ACRFVLK(ACRXIEN)

 I ACRDUN]"",ACRXDUN]"",ACRDUN'=ACRXDUN Q 0  ;DIFFERENT DUNS

 Q 1                                         ;IT IS A DUPLICATE

 ; ****************************

CCVEN() ;EP; RETRIEVE CREDIT CARD VENDOR FROM FMS SYSTEM DEFAULT FILE

 ;

 N X

 S X=$P($G(^ACRSYS(1,501)),U)

 S:X']"" X=0

 Q X

CHS() ;EP - CHECK FOR CHS DOCUMENTS *********

 I ACRCREF'=323,ACRCREF'=324,ACRCREF'=325 Q 0  ;NOT CHS REFERENCE CODES

 I $E(ACRCCAN,5)'?1A Q 0

 I ACRAP=94 Q 0                                ;HQ -- ADMIN NO CHS

 I ACRAP=59 Q 0                                ;ALASKA -- NO CHS

 I '$$OCC(ACRCOCC) Q 0                         ;WRONG OBJECT CLASS CODE

 N ACRE3

 S ACRE3=$E(ACRCDOC,3)

 I ACRAP=53,ACRE3="Q" Q 1         ;ALBUQUERQUE

 I ACRAP=45,ACRE3="C" Q 1         ;ABERDEEN

 I ACRAP=46,ACRE3="D" Q 1         ;BEMIDJI

 I ACRAP=47,ACRE3="B" Q 1         ;BILLINGS

 I ACRAP=51,ACRE3="U" Q 1         ;NASHVILLE

 I ACRAP=54,ACRE3="N" Q 1         ;NAVAJO

 I ACRAP=50,ACRE3="O" Q 1         ;OKLAHOMA

 I ACRAP=40,ACRE3="X" Q 1         ;PHOENIX

 I ACRAP=64,ACRE3="P" Q 1         ;PORTLAND

 I ACRAP=42,ACRE3="S" Q 1         ;TUCSON

 I ACRAP=41,ACRE3="L" Q 1         ;CALIFORNIA

 I ACRE3="A" Q 1                  ;BELONGS SOMEWHERE

 Q 0

 ; ****************************

OCC(Z) ;CHECK OBJECT CLASS CODE FOR FI PAID

 ; -- Enters with CORE Object Class Code

 ;

 I Z="2611" Q 0            ;IHS PAID CODE

 ;    List contains only OCC that FI pays

 I Z="256Q" Q 1

 I Z="256R" Q 1

 I Z="256T" Q 1

 I Z="2185" Q 1

 I Z="263A" Q 1

 I Z="263G" Q 1

 I Z="263K" Q 1

 I Z="4319" Q 1

 Q 0

 ; ********************************

UPPER(X,Z) ; CONVERT TO UPPER CASE

 ;ENTER WITH X=VENDOR IEN, Z=VENDOR NAME

 N NAME

 S NAME=$$UPPER^ACRFUTL(Z)

 S DIE="^AUTTVNDR("

 S DA=X

 S DR=".01///"_NAME

 D DIE^ACRFDIC

 Q

 ; ******************************

ORGSET(X) ; SET MISSING ORG/IND FIELD IF VALID NUMBER

 I ACREINP'=1,ACREINP'=2 Q

 S DIE="^AUTTVNDR("

 S DA=X

 S DR="1119///"_ACREINP

 D DIE^ACRFDIC

 Q

ACRFUFMU  ;IHS/OIRM/DSD/AEF - OPEN DOCUMENTS MATCH FROM CORE FOR UFMS [ 05/21/2007   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGMT SYSTEM;**22**;NOV 05, 2001

 +2       ;  NEW ROUTINE ACR*2.1*22 UFMS

 +3       ;

PIECE     ;EP;

 +1        IF ACROCCDA]""

               Begin DoDot:1

 +2                SET ACROCC=$PIECE($GET(^AUTTOBJC(ACROCCDA,0)),U)

               End DoDot:1

 +3        IF ACRCANDA]""

               Begin DoDot:1

 +4                SET ACRCAN=$PIECE($GET(^AUTTCAN(ACRCANDA,0)),U)

               End DoDot:1

 +5        QUIT 

 +6       ;

 +7       ; ****************************

MATCH()   ;EP;

 +1        IF ACRCCAN'=ACRCAN

               QUIT 0

 +2        IF ACRCOCC'=ACROCC

               QUIT 0

 +3       ;MATCH

           IF ACRCFY=ACRFY

               QUIT 1

 +4       ;ACCOMODATE 2-DIGIT FY

           IF $EXTRACT(ACRCFY,3,4)'=ACRFY

               QUIT 0

 +5       ;MATCH

           QUIT 1

 +6       ;

 +7       ; ****************************

MATCH2(ACRXX,I,ACRV) ;EP; FIND MATCH IN ARRAY

 +1       ;

 +2       ;NOT A MATCH

           IF '$DATA(ACRXX(1,I))

               QUIT 0

 +3       ;SEND BACK ITEM DA

           SET ACRMATCH=$GET(ACRXX(1,I,ACRV))

 +4        IF ACRMATCH=""

               SET ACRMATCH=$GET(ACRXX(1,I,0))

 +5        IF ACRMATCH=""

               SET ACRMATCH=0

 +6        QUIT ACRMATCH

 +7       ;

 +8       ; ****************************

CKVEND(ACRV) ;EP; CHECK FOR MISSING VENDOR DATA

 +1       ;

 +2       ;    Enters with: ACRV = Vendor file IEN

 +3       ;    Returns:  NULL or

 +4       ;              Error string

 +5        SET ACRERR=""

 +6       ;DON'T WANT TRAVEL VENDORS

           IF $GET(ACRCTYP)="TR"

               QUIT ACRERR

 +7        SET ACRCEIN=$GET(ACRCEIN)

 +8        SET ACRCORE=$GET(ACRCORE)

 +9        IF '$DATA(ACR)

               SET ACR=0

 +10       NEW ACRTEIN

 +11       DO NAMCHK(ACRV)

 +12       DO DUNSCHK(ACRV)

 +13      ;CHECKS EIN,SUFFIX & DUPS

           DO EINCHK(ACRV)

 +14       IF ACRCEIN]""

               IF ACRCEIN'[11111111

                   Begin DoDot:1

 +15                   SET ACRTEIN=ACREIN_ACRSFX

 +16                   IF ACRCEIN'=ACRTEIN

                           Begin DoDot:2

 +17      ;RECORD BAD MATCH

                               SET ^ACRZ("CEIN",ACR)=ACRCEIN_"/"_ACRTEIN_" NO MATCH"_U_ACRCORE

 +18                           SET ACRERR=ACRERR_"CORE EIN "_ACRCEIN_" does not match IHS "_ACRTEIN_U

                           End DoDot:2

                   End DoDot:1

 +19       DO ADDCHK(ACRV)

 +20       DO BANK(ACRV)

 +21       IF $$IDATE(ACRV)

               Begin DoDot:1

 +22               SET ACRERR="Inactive** "_U_ACRERR

               End DoDot:1

 +23       QUIT ACRERR

 +24      ; ****************************

BANK(ACRV) ;EP; CHECK EFT BANKING INFORMATION

 +1       ;

 +2       ;    Enters with: ACRV = Vendor file IEN

 +3       ;    Returns:  Error string

 +4        NEW ACREFTT,ACRRT,ACRBANK

 +5       ;REMOVES DELIMITERS

           SET ACRBANK=$TRANSLATE($GET(^AUTTVNDR(ACRV,19)),U)

 +6        IF ACRBANK=""

               Begin DoDot:1

 +7                SET ACRERR=ACRERR_"No EFT"_U

               End DoDot:1

               QUIT 

 +8       ;ACCOUNT TYPE

           SET ACREFTT=$$EFTAT(ACRV)

 +9       ;ROUTING NUMBER

           SET ACRRT=$$EFTRT(ACRV)

 +10      ;ACCOUNT NUMBER

           SET ACRACNT=$$EFTDA(ACRV)

 +11       IF ACRACNT'?5.N

               Begin DoDot:1

 +12               DO SETDATE(ACRV)

 +13               SET ACRERR=ACRERR_"Bad Account Number "_ACRACNT_U

               End DoDot:1

 +14       IF '$$RCK(ACRRT)!(ACRRT'?5.N)

               Begin DoDot:1

 +15               SET ACRERR=ACRERR_"Bad Bank Routing Number "_ACRRT_U

 +16               DO SETDATE(ACRV)

               End DoDot:1

 +17       IF ACREFTT'="S"

               IF ACREFTT'="C"

                   Begin DoDot:1

 +18                   SET ACRERR=ACRERR_"Missing/Bad Acct Type "_ACREFTT_U

 +19                   DO SETDATE(ACRV)

                   End DoDot:1

 +20       QUIT 

 +21      ; ****************************

ADDCHK(ACRV) ;EP;  CHECK VENDOR MAILING ADDRESS ZIP

 +1       ;

 +2       ;    Enters with: ACRV = Vendor file IEN

 +3       ;    Returns:  Error string

 +4       ;

 +5        NEW ACRZIP,ACRZIP2

 +6        SET ACRZIP=$$MZIP(ACRV)

 +7        SET ACRZIP2=$TRANSLATE(ACRZIP,"-")

 +8        IF ACRZIP2'?9N

               Begin DoDot:1

 +9                SET ACRERR=ACRERR_"Mailing ZIP "_ACRZIP_U

               End DoDot:1

 +10       QUIT 

 +11      ; ****************************

NAMCHK(ACRV) ;EP; CHECK VENDOR NAME AND INACTIVE STATUS

 +1       ;

 +2       ;    Enters with: ACRV = Vendor file IEN

 +3       ;    Returns:  Error string

 +4       ;              Inactive flag

 +5       ;

 +6        NEW ACRE1,ACRE2

 +7        SET ACRVNAM=$$VNAME(ACRV)

 +8        IF ACRVNAM=""

               Begin DoDot:1

 +9                SET ACRERR="Vendor Name Missing"_U

 +10               DO SETDATE(ACRV)

               End DoDot:1

 +11       SET ACRE1=$EXTRACT(ACRVNAM)

 +12       SET ACRE2=$EXTRACT(ACRVNAM,1,2)

 +13      ;FORCE ERROR MESSAGE

           IF $EXTRACT(ACRVNAM,1,6)?6N

               SET ACRE1=" "

 +14      ;NO LOWER CASE

           IF ACRE1?1L!($EXTRACT(ACRVNAM,2)?1L)

               DO UPPER(ACRV,ACRVNAM)

 +15       IF ACRVNAM["DO NOT USE"!(ACRVNAM["DON'T USE")!(ACRVNAM["DONT USE")!(ACRVNAM["NOT SPECIFIED")

               SET ACRE1=" "

 +16       IF ACRE1=" "!(ACRE1=".")!(ACRE2="ZZ")!(ACRE2="XX")!(ACRE1="""")!(ACRE1="'")!(ACRE1=",")

               Begin DoDot:1

 +17               SET ACRERR=ACRERR_"Bad Vendor Name "_ACRVNAM_U

 +18               DO SETDATE(ACRV)

               End DoDot:1

 +19       QUIT 

 +20      ;

 +21      ; ****************************

DUNSCHK(ACRV) ; EP - CHECK FOR DUNS

 +1       ;

 +2       ;    Enters with: ACRV = Vendor file IEN

 +3       ;    Returns:  Error string

 +4       ;

 +5        NEW ACRDUN

 +6        SET ACRDUN=$$DUNS^ACRFVLK(ACRV)

 +7       ;FORCE ERROR

           IF ACRDUN[99999!(ACRDUN[11111)!(ACRDUN["00000")

               SET ACRDUN="BAD"

 +8       ;MISSING OR WRONG LENGTH

           IF ACRDUN'?9N

               IF ACRDUN'?13N

                   Begin DoDot:1

 +9                    SET DA=ACRV

 +10                   SET DIE="^AUTTVNDR("

 +11                   SET DR=".07///^S X=""@"""

 +12                   DO ^DIE

 +13                   SET ACRERR=ACRERR_"DUNS missing"_U

                   End DoDot:1

 +14       QUIT 

 +15      ;

 +16      ; ****************************

EINCHK(ACRV) ;EP; CHECK EIN FOR VENDORS WITH THE SAME EIN NO

 +1       ;

 +2       ;    Enters with: ACRV = Vendor file IEN

 +3       ;    Returns:  Error string

 +4       ;    Enters with ACRNODUP if called outside of UFMS routines

 +5       ;

 +6        NEW ACREINP,ACRXEIN,ACRXIEN,Z,I

 +7        SET ACRSFX=""

 +8        SET ACREIN=$$EIN(ACRV)

 +9        IF ACREIN=""

               Begin DoDot:1

 +10               SET ACRERR=ACRERR_"EIN is Missing "_U

 +11      ;MAKE INACTIVE

                   DO SETDATE(ACRV)

               End DoDot:1

               QUIT 

 +12       SET Z=ACREIN

 +13      ;CHECK FOR 5 SEQUENTIAL NUMBERS

           IF ACRERR["DUNS missing"

               Begin DoDot:1

 +14               IF Z["00000"

                       SET Z=""

                       QUIT 

 +15               IF Z[11111

                       SET Z=""

                       QUIT 

 +16               IF Z[22222

                       SET Z=""

                       QUIT 

 +17               IF Z[33333

                       SET Z=""

                       QUIT 

 +18               IF Z[44444

                       SET Z=""

                       QUIT 

 +19               IF Z[55555

                       SET Z=""

                       QUIT 

 +20               IF Z[66666

                       SET Z=""

                       QUIT 

 +21               IF Z[77777

                       SET Z=""

                       QUIT 

 +22               IF Z[88888

                       SET Z=""

                       QUIT 

 +23               IF Z[99999

                       SET Z=""

                       QUIT 

 +24               IF Z[101010

                       SET Z=""

                       QUIT 

               End DoDot:1

 +25       IF Z'?10N

               Begin DoDot:1

 +26               SET ACRERR=ACRERR_"EIN has Bad Format "_ACREIN_U

 +27      ;MAKE INACTIVE

                   DO SETDATE(ACRV)

               End DoDot:1

 +28       SET ACRSFX=$$SFX(ACRV)

 +29       SET ACREINP=$EXTRACT(ACREIN)

 +30       SET ACRORG=$$ORG(ACRV)

 +31       IF ACRORG=""

               DO ORGSET(ACRV)

 +32       IF ACRORG]""

               IF ACRORG'=ACREINP

                   Begin DoDot:1

 +33                   SET ACRERR=ACRERR_"EIN prefix does not match Org/Ind "_ACREINP_"/"_ACRORG_U

 +34      ;MAKE INACTIVE

                       DO SETDATE(ACRV)

                   End DoDot:1

 +35       IF ACREINP'=1

               IF ACREINP'=2

                   Begin DoDot:1

 +36                   SET ACRERR=ACRERR_"Bad EIN prefix "_ACREINP_U

 +37      ;MAKE INACTIVE

                       DO SETDATE(ACRV)

                   End DoDot:1

 +38       SET ACRXEIN=""

 +39       IF '$DATA(ACRNODUP)

               FOR 

                   SET ACRXEIN=$ORDER(^AUTTVNDR("E",ACRXEIN))

                   IF ACRXEIN=""

                       QUIT 

                   Begin DoDot:1

 +40                   IF $EXTRACT(ACRXEIN,1,10)'=ACREIN

                           QUIT 

 +41                   SET ACRXIEN=""

 +42                   FOR 

                           SET ACRXIEN=$ORDER(^AUTTVNDR("E",ACRXEIN,ACRXIEN))

                           IF 'ACRXIEN

                               QUIT 

                           Begin DoDot:2

 +43      ;DON'T COUNT SELF

                               IF ACRXIEN=ACRV

                                   QUIT 

 +44      ;DON'T ADD MULTIPLE DUPS

                               IF ACRERR["Duplicate"

                                   QUIT 

 +45      ;DON'T COUNT INACTIVE DUPS

                               IF $$IDATE(ACRXIEN)

                                   QUIT 

 +46      ;QUIT IF NOT A DUPLICATE

                               IF '$$DUPCHK(ACRV,ACRXIEN)

                                   QUIT 

 +47                           SET ACRERR=ACRERR_"Duplicate EIN "_$$EIN(ACRXIEN)_"  "_$$SFX(ACRXIEN)_U

                           End DoDot:2

                   End DoDot:1

 +48      ;BAD SUFFIX -- ALL VENDORS

           IF ACRSFX=""!(ACRSFX'?2UN)

               Begin DoDot:1

 +49               SET ACRERR=ACRERR_"Missing or Bad Suffix "_ACRSFX_U

               End DoDot:1

 +50       QUIT 

 +51      ;

 +52      ; ****************************

VNAME(X)  ;EP     ;----- RETURNS NAME OF VENDOR

 +1       ;

 +2       ;      X  = VENDOR IEN

 +3       ;

 +4        NEW Y

 +5        SET Y=""

 +6       ;FREE TEXT

           IF X

               SET Y=$PIECE($GET(^AUTTVNDR(X,0)),U)