ACRFUFM4 ;IHS/OIT/FJE - UFMS VENDOR FILE SUMMARY 3 ; [ 12/26/2006 10:56 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**22**;NOV 5, 2001
;
; New routine ACR*2.1*22
Q
PRINTSUM ;EP - PRINT VENDORS MISSING DATA
;SELECT DEVICE TO PRINT REPORT
;
;D HEADER
;D VM^ACRFMENU
;S DIR(0)="S^N:DUPLICATE NAMES;D:DUPLICATE DUN"
;S DIR=DIR(0)_"A:DUPLICATE ADDRESS LINE 1;"
;S DIR(0)=DIR(0)_"R:DUPLICATE REMIT ADDRESS LINE 1;"
;S DIR(0)=DIR(0)_"T:DUPLICATE EIN;E:DUPLICATE EIN+SUFFUX;"
;S DIR(0)=DIR(0)_"C:DUPLICATE BANK ROUTING #;B:DUPLICATE BANK ACCOUNT;"
S DIR(0)="S^N:DUPLICATE NAMES;"
S DIR(0)=DIR(0)_"D:DUPLICATE DUNS;"
S DIR(0)=DIR(0)_"A:DUPLICATE ADDRESS LINE 1;"
S DIR(0)=DIR(0)_"R:DUPLICATE REMIT ADDRESS LINE 1;"
S DIR(0)=DIR(0)_"T:DUPLICATE EIN;"
S DIR(0)=DIR(0)_"E:DUPLICATE EIN+SUFFIX;"
S DIR(0)=DIR(0)_"B:DUPLICATE BANK ACCOUNTS;"
S DIR(0)=DIR(0)_"S:SUMMARY OF DUPLICATES;"
S DIR(0)=DIR(0)_"H:HELP"
S DIR("A")="UFMS DUPLICATE VENDOR INFORMATION REPORT"
S DIR("B")="S"
KILL DA,ACROUT,ACRQUIT
D DIR^ACRFDIC
Q:$D(ACRQUIT)
;Q:'"NDARTEBC"[Y
Q:'"NDARTEBSH"[Y
S ACRFVY=Y
S (ZTRTN,ACRRTN)="SUM^ACRFUFM4"
S ZTDESC="VENDORS SUMMARY DIAGNOSIS"
K ACRHFS,ACRDIR,ACRFILE
S ACR("HFS")=""
D ^ACRFZIS
K ACR("HFS")
I $D(ACRHFS) D
.S ACRDIR=ZISH1
.S ACRFILE=ZISH2
.D SUM
.D PROCHFS^ACRFVLK2
Q
SUM ;EP - GATHER ACTIVE VENDORS MISSING DATA
K ACRFV0,ACRFV11,ACRFV13,ACRFV19,ACRFVREC,ACROUT,ACRFVNAM
S X="VENDORS UFMS READINESS SUMMARY REPORT"
D EN^ACRFUFM2("")
I $D(ACRHFS)&($D(%FILE)) D
.U %FILE
.W X,!
E W !!?80-$L(X)/2,X
S Y=DT X ^DD("DD")
I $D(ACRHFS)&($D(%FILE)) D
.U %FILE
.W Y,!
E W !?80-$L(X)/2,Y
I "N"[ACRFVY D HEAD1
I "D"[ACRFVY D HEAD2
I "A"[ACRFVY D HEAD3
I "R"[ACRFVY D HEAD4
I "T"[ACRFVY D HEAD5
I "E"[ACRFVY D HEAD6
;I "C"[ACRFVY D HEAD7
I "B"[ACRFVY D HEAD8
I "H"[ACRFVY D HEAD9
I "S"[ACRFVY D HEAD10
S (ACRFVREC,ACRFVXCT,ACRFVXT,ACRFVXN,ACRFVXD,ACRFVXA1)=0
S (ACRFVXR1,ACRFVXE1,ACRFVXE2)=0
S (ACRFVXB1,ACRFVXB2)=0
F S ACRFVREC=$O(^TMP("ACRAVEN",$J,ACRFVREC)) Q:'ACRFVREC!($D(ACROUT)) D
.S ACRFV0=$G(^AUTTVNDR(ACRFVREC,0))
.Q:$G(ACRFV0)=""
.S ACRFV11=$G(^AUTTVNDR(ACRFVREC,11))
.S ACRFV13=$G(^AUTTVNDR(ACRFVREC,13))
.S ACRFV14=$G(^AUTTVNDR(ACRFVREC,14))
.S ACRFV19=$G(^AUTTVNDR(ACRFVREC,19)) ;BANKING INFO
.S ACRFVNAM=$P(ACRFV0,U)
.S ACRFVXT=ACRFVXT+1 ;TO GET TOTAL IN VENDOR FILE
.I $P(ACRFV0,U,5)="" D
..S ACRFVXCT=ACRFVXCT+1
..;IF VENDOR HAS DUP NAME
..S ACRFVX=$P(ACRFV0,U,1) D
...Q:ACRFVX=""
...I $D(^TMP("ACR",$J,"NAM",ACRFVX)) D
....S ACRFVXN=ACRFVXN+1
....S ^TMP("ACR",$J,"NAMD",ACRFVREC)=ACRFVREC_U_ACRFVX
....S ACRFVX1=$P(^TMP("ACR",$J,"NAM",ACRFVX),U,1)
....S ACRFVX2=$P(^TMP("ACR",$J,"NAM",ACRFVX),U,2)
....S ACRFVX3=$P(^TMP("ACR",$J,"NAM",ACRFVX),U,3)
....S ^TMP("ACR",$J,"NAMD",ACRFVX1)=ACRFVX2_U_ACRFVX3
...S ^TMP("ACR",$J,"NAM",ACRFVX)=ACRFVREC_U_ACRFVREC_U_ACRFVX
..;IF VENDOR HAS DUP DUNS
..S ACRFVX=$P(ACRFV0,U,7) D
...Q:ACRFVX=""
...I $D(^TMP("ACR",$J,"DUNS",ACRFVX)) D
....S ACRFVXD=ACRFVXD+1
....S ^TMP("ACR",$J,"DUND",ACRFVREC)=ACRFVNAM_U_ACRFVX
....S ACRFVX1=$P(^TMP("ACR",$J,"DUNS",ACRFVX),U,1)
....S ACRFVX2=$P(^TMP("ACR",$J,"DUNS",ACRFVX),U,2)
....S ACRFVX3=$P(^TMP("ACR",$J,"DUNS",ACRFVX),U,3)
....S ^TMP("ACR",$J,"DUND",ACRFVX1)=ACRFVX2_U_ACRFVX3
...S ^TMP("ACR",$J,"DUNS",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
..;IF VENDOR HAS DUP ADDRESS LINE 1
..S ACRFVX=$P(ACRFV13,U,1) D
...Q:ACRFVX=""
...I $D(^TMP("ACR",$J,"AD1",ACRFVX)) D
....S ACRFVXA1=ACRFVXA1+1
....S ^TMP("ACR",$J,"AD1D",ACRFVREC)=ACRFVNAM_U_ACRFVX
....S ACRFVX1=$P(^TMP("ACR",$J,"AD1",ACRFVX),U,1)
....S ACRFVX2=$P(^TMP("ACR",$J,"AD1",ACRFVX),U,2)
....S ACRFVX3=$P(^TMP("ACR",$J,"AD1",ACRFVX),U,3)
....S ^TMP("ACR",$J,"AD1D",ACRFVX1)=ACRFVX2_U_ACRFVX3
...S ^TMP("ACR",$J,"AD1",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
..;IF VENDOR HAS DUP REMIT ADDRESS LINE 1
..S ACRFVX=$P(ACRFV14,U,1) D
...Q:ACRFVX=""
...I $D(^TMP("ACR",$J,"RAD1",ACRFVX)) D
....S ACRFVXR1=ACRFVXR1+1
....S ^TMP("ACR",$J,"RAD1D",ACRFVREC)=ACRFVNAM_U_ACRFVX
....S ACRFVX1=$P(^TMP("ACR",$J,"RAD1",ACRFVX),U,1)
....S ACRFVX2=$P(^TMP("ACR",$J,"RAD1",ACRFVX),U,2)
....S ACRFVX3=$P(^TMP("ACR",$J,"RAD1",ACRFVX),U,3)
....S ^TMP("ACR",$J,"RAD1D",ACRFVX1)=ACRFVX2_U_ACRFVX3
...S ^TMP("ACR",$J,"RAD1",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
..;IF VENDOR IS ACTIVE & EIN IS DUPLICATE
..S ACRFVX=$P(ACRFV11,U,1) D
...Q:ACRFVX=""
...I $D(^TMP("ACR",$J,"TIN",ACRFVX)) D
....S ACRFVXE1=ACRFVXE1+1
....S ^TMP("ACR",$J,"TIND",ACRFVREC)=ACRFVNAM_U_ACRFVX
....S ACRFVX1=$P(^TMP("ACR",$J,"TIN",ACRFVX),U,1)
....S ACRFVX2=$P(^TMP("ACR",$J,"TIN",ACRFVX),U,2)
....S ACRFVX3=$P(^TMP("ACR",$J,"TIN",ACRFVX),U,3)
....S ^TMP("ACR",$J,"TIND",ACRFVX1)=ACRFVX2_U_ACRFVX3
...S ^TMP("ACR",$J,"TIN",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
..;IF VENDOR IS ACTIVE & EIN+SUFFIX IS DUPLICATE
..S ACRFVX=$P(ACRFV11,U,13) D
...Q:ACRFVX=""
...I $D(^TMP("ACR",$J,"EIN",ACRFVX)) D
....S ACRFVXE2=ACRFVXE2+1
....S ^TMP("ACR",$J,"EIND",ACRFVREC)=ACRFVNAM_U_ACRFVX
....S ACRFVX1=$P(^TMP("ACR",$J,"EIN",ACRFVX),U,1)
....S ACRFVX2=$P(^TMP("ACR",$J,"EIN",ACRFVX),U,2)
....S ACRFVX3=$P(^TMP("ACR",$J,"EIN",ACRFVX),U,3)
....S ^TMP("ACR",$J,"EIND",ACRFVX1)=ACRFVX2_U_ACRFVX3
...S ^TMP("ACR",$J,"EIN",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
..;IF VENDOR IS ACTIVE & BANK INFO IS DUPLICATE
..S ACRFVXR=$P(ACRFV19,U,2) D ;ROUTING NUMBER
...Q:ACRFVXR=""
...S ACRFVXA=$P(ACRFV19,U,3) ;ACCOUNT NUMBER
...S ACRFVX=ACRFVXR_"-"_ACRFVXA ;COMBINE ROUTING AND ACCOUNT NUMBERS
...I $D(^TMP("ACR",$J,"BR1",ACRFVX)) D
....S ACRFVXB1=ACRFVXB1+1
....S ^TMP("ACR",$J,"BR1D",ACRFVREC)=ACRFVNAM_U_ACRFVX
....S ACRFVX1=$P(^TMP("ACR",$J,"BR1",ACRFVX),U,1)
....S ACRFVX2=$P(^TMP("ACR",$J,"BR1",ACRFVX),U,2)
....S ACRFVX3=$P(^TMP("ACR",$J,"BR1",ACRFVX),U,3)
....S ^TMP("ACR",$J,"BR1D",ACRFVX1)=ACRFVX2_U_ACRFVX3
...S ^TMP("ACR",$J,"BR1",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
..;S ACRFVX=$P(ACRFV19,U,3) D
..;.Q:ACRFVX=""
..;.I $D(^TMP("ACR",$J,"BR2",ACRFVX)) D
..;..S ACRFVXB2=ACRFVXB2+1
..;..S ^TMP("ACR",$J,"BR2D",ACRFVREC)=ACRFVNAM_U_ACRFVX
..;..S ACRFVX1=$P(^TMP("ACR",$J,"BR2",ACRFVX),U,1)
..;..S ACRFVX2=$P(^TMP("ACR",$J,"BR2",ACRFVX),U,2)
..;..S ACRFVX3=$P(^TMP("ACR",$J,"BR2",ACRFVX),U,3)
..;..S ^TMP("ACR",$J,"BR2D",ACRFVX1)=ACRFVX2_U_ACRFVX3
..;.S ^TMP("ACR",$J,"BR2",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
;
S ACRFVC=""
S ACRFVNAM=""
S ACRFVREC=""
I ACRFVY="N" S ACRFVC="NAMD"
I ACRFVY="D" S ACRFVC="DUND"
I ACRFVY="A" S ACRFVC="AD1D"
I ACRFVY="R" S ACRFVC="RAD1D"
I ACRFVY="T" S ACRFVC="TIND"
I ACRFVY="E" S ACRFVC="EIND"
I ACRFVY="B" S ACRFVC="BR1D"
I ACRFVY="S" K ^TMP("ACR",$J) D BLDSUM Q
I ACRFVY="H" K ^TMP("ACR",$J) D HELP Q
S ACRFVREC=""
F S ACRFVREC=$O(^TMP("ACR",$J,ACRFVC,ACRFVREC)) Q:ACRFVREC=""!($D(ACROUT)) D
.S ACRFVX1=$P(^TMP("ACR",$J,ACRFVC,ACRFVREC),U,1)
.S ACRFVX2=$P(^TMP("ACR",$J,ACRFVC,ACRFVREC),U,2)
.I ACRFVX1="" S ACRFVX1="UNK1"
.I ACRFVX2="" S ACRFVX2="UNK2"
.S ^TMP("ACR",$J,"SORT",ACRFVX2,ACRFVX1,ACRFVREC)=""
S (ACRFVX1,ACRFVX2,ACRFVREC)=""
F S ACRFVX2=$O(^TMP("ACR",$J,"SORT",ACRFVX2)) Q:ACRFVX2=""!($D(ACROUT)) D
.S ACRFVX1="" F S ACRFVX1=$O(^TMP("ACR",$J,"SORT",ACRFVX2,ACRFVX1)) Q:ACRFVX1=""!($D(ACROUT)) D
..S ACRFVREC="" F S ACRFVREC=$O(^TMP("ACR",$J,"SORT",ACRFVX2,ACRFVX1,ACRFVREC)) Q:ACRFVREC=""!($D(ACROUT)) D
...I $D(ACRHFS)&($D(%FILE)) D Q
....U %FILE
....W !,ACRFVX2_U_ACRFVX1
...W !,ACRFVX2,?34,ACRFVX1
...I '$D(ACRHFS),$Y>(IOSL-4) D PAUSE^ACRFWARN W @IOF Q
I '$D(ACRHFS) D PAUSE^ACRFWARN W @IOF
K ^TMP("ACR",$J)
Q
BLDSUM ;BUILDS SUMMARY TMP GLOBAL
S ^TMP("ACR",$J,"1")="Active Vendors"_U_ACRFVXCT
S ^TMP("ACR",$J,"2")="Duplicate Names"_U_ACRFVXN
S ^TMP("ACR",$J,"3")="Duplicate DUNS"_U_ACRFVXD
S ^TMP("ACR",$J,"4")="Duplicate Address Line 1"_U_ACRFVXA1
S ^TMP("ACR",$J,"5")="Duplicate Remit Address Line 1"_U_ACRFVXR1
S ^TMP("ACR",$J,"6")="Duplicate EIN"_U_ACRFVXE1
S ^TMP("ACR",$J,"7")="Duplicate EIN_Suffix"_U_ACRFVXE2
;S ^TMP("ACR",$J,"8")="Duplicate Bank Routing"_U_ACRFVXB1
;S ^TMP("ACR",$J,"9")="Duplicate Bank Acct"_U_ACRFVXB2
S ^TMP("ACR",$J,"8")="Duplicate Bank Accounts"_U_ACRFVXB1
S ACRFVREC="" F S ACRFVREC=$O(^TMP("ACR",$J,ACRFVREC)) Q:ACRFVREC=""!($D(ACROUT)) D
.I $D(ACRHFS)&($D(%FILE)) D Q
..U %FILE
..W !,^TMP("ACR",$J,ACRFVREC)
.W !,$P(^TMP("ACR",$J,ACRFVREC),U,1),?34,$P(^TMP("ACR",$J,ACRFVREC),U,2)
.I '$D(ACRHFS),$Y>(IOSL-4) D PAUSE^ACRFWARN W @IOF Q
I '$D(ACRHFS) D PAUSE^ACRFWARN W @IOF
K ^TMP("ACR",$J)
Q
HEAD1 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE NAME"_U_"VENDOR IEN"
W !,"DUPLICATE NAME",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD2 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE DUNS"_U_"VENDOR IEN"
W !,"DUPLICATE DUNS",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD3 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE ADDRESS LINE 1"_U_"VENDOR IEN"
W !,"DUPLICATE ADDRESS LINE 1",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD4 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE REMIT ADDRESS LINE 1"_U_"VENDOR IEN"
W !,"DUPLICATE REMIT ADDRESS LINE 1",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD5 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE EIN"_U_"VENDOR IEN"
W !,"DUPLICATE EIN",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD6 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE EIN+SUFFIX"_U_"VENDOR IEN"
W !,"DUPLICATE EIN+SUFFIX",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD7 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE BANK ACCOUNTS"_U_"VENDOR IEN"
W !,"DUPLICATE BANK ACCOUNTS",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD8 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE BANK ACCOUNTS"_U_"VENDOR IEN"
W !,"DUPLICATE BANK ACCOUNTS",?34,"VENDOR IEN"
W !,"-------------------------------------------------------------------------------"
Q
HEAD9 ;EP - HEADING3-if Help
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "Vendor DUPLICATE Help"_U_""
W !,"Vendor DUPLICATE Help",?34,""
W !,"-------------------------------------------------------------------------------"
Q
HEAD10 ;EP - HEADING1 if detailed
I $D(ACRHFS)&($D(%FILE)) D Q
.U %FILE
.W "DUPLICATE SUMMARY"_U_"TOTAL"
W !,"DUPLICATE SUMMARY",?34,"TOTAL"
W !,"-------------------------------------------------------------------------------"
Q
HELP ;EP HELP INFORMATION FOR SUMMARY REPORT
S ^TMP("ACR",$J,"1")="The Code for each Vendor is grouped by dashes 0-0000-0000-0000-0000"
S ^TMP("ACR",$J,"2")="DUNS, Address, Remit Address, TAX ID Info, Bank Info, Misc Info"
S ^TMP("ACR",$J,"3")="If the Code is zero (0) the specific data appears to be good."
S ^TMP("ACR",$J,"4")="If the Code is numeric then the program has found a problem with the data"
S ^TMP("ACR",$J,"5")="First - number:DUNS 1=missing DUNS, 2=DUNS not 9 or 9+4 in length,"
S ^TMP("ACR",$J,"6")=" 4=DUNS contains alpha characters, 6 both of the above"
S ^TMP("ACR",$J,"7")="Second - Group:Address 1=address line 1 ,2=city, 3=state, 4=Zip code"
S ^TMP("ACR",$J,"8")=" Address Line 1: 1=missing"
S ^TMP("ACR",$J,"9")=" City: 1=missing"
S ^TMP("ACR",$J,"10")=" State: 1=missing"
S ^TMP("ACR",$J,"11")=" ZIP Code: 1=missing, 2=not 9 digits, 4=alpha char, 6=both"
S ^TMP("ACR",$J,"12")="Third - Group:Remit Address 1=address line 1,2=city,3=state,4=Zip code"
S ^TMP("ACR",$J,"13")=" Address Line 1: 1=missing"
S ^TMP("ACR",$J,"14")=" City: 1=missing"
S ^TMP("ACR",$J,"15")=" State: 1=missing"
S ^TMP("ACR",$J,"16")=" ZIP Code: 1=missing, 2=not 9 digits, 4=alpha char, 6=both"
S ^TMP("ACR",$J,"17")="Fourth - Group:Tax ID 1=EIN, 2=suffix, 3=proper EIN, 4=proper suffix"
S ^TMP("ACR",$J,"18")=" EIN: 1=missing"
S ^TMP("ACR",$J,"19")=" Suffix: 1=missing"
S ^TMP("ACR",$J,"20")=" EIN Info: 1=not 10 digits, 2=first digit not 1 or 2, 4=contains alpha"
S ^TMP("ACR",$J,"21")=" Suffix Info: 1=not 2 in length, 2=first not alpha, 4=second not numeric"
S ^TMP("ACR",$J,"22")="Fifth - Group:Bank ID 1=Type, 2=Routing, 3=Account, 4=Routing CheckSum"
S ^TMP("ACR",$J,"23")=" Type: 1=missing"
S ^TMP("ACR",$J,"24")=" Routing: 1=missing"
S ^TMP("ACR",$J,"25")=" Account: 1=missing"
S ^TMP("ACR",$J,"26")=" CheckSum: 1=not valid, 2=not 9 digits, 4=contains alpha char"
S ACRFVREC="" F S ACRFVREC=$O(^TMP("ACR",$J,ACRFVREC)) Q:ACRFVREC=""!($D(ACROUT)) D
.I $D(ACRHFS)&($D(%FILE)) D Q
..U %FILE
..W !,^TMP("ACR",$J,ACRFVREC)
.W !,$P(^TMP("ACR",$J,ACRFVREC),U,1),?34,$P(^TMP("ACR",$J,ACRFVREC),U,2)
.I '$D(ACRHFS),$Y>(IOSL-4) D PAUSE^ACRFWARN W @IOF Q
I '$D(ACRHFS) D PAUSE^ACRFWARN W @IOF
K ^TMP("ACR",$J)
Q
ACRFUFM4 ;IHS/OIT/FJE - UFMS VENDOR FILE SUMMARY 3 ; [ 12/26/2006 10:56 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**22**;NOV 5, 2001
+2 ;
+3 ; New routine ACR*2.1*22
+4 QUIT
PRINTSUM ;EP - PRINT VENDORS MISSING DATA
+1 ;SELECT DEVICE TO PRINT REPORT
+2 ;
+3 ;D HEADER
+4 ;D VM^ACRFMENU
+5 ;S DIR(0)="S^N:DUPLICATE NAMES;D:DUPLICATE DUN"
+6 ;S DIR=DIR(0)_"A:DUPLICATE ADDRESS LINE 1;"
+7 ;S DIR(0)=DIR(0)_"R:DUPLICATE REMIT ADDRESS LINE 1;"
+8 ;S DIR(0)=DIR(0)_"T:DUPLICATE EIN;E:DUPLICATE EIN+SUFFUX;"
+9 ;S DIR(0)=DIR(0)_"C:DUPLICATE BANK ROUTING #;B:DUPLICATE BANK ACCOUNT;"
+10 SET DIR(0)="S^N:DUPLICATE NAMES;"
+11 SET DIR(0)=DIR(0)_"D:DUPLICATE DUNS;"
+12 SET DIR(0)=DIR(0)_"A:DUPLICATE ADDRESS LINE 1;"
+13 SET DIR(0)=DIR(0)_"R:DUPLICATE REMIT ADDRESS LINE 1;"
+14 SET DIR(0)=DIR(0)_"T:DUPLICATE EIN;"
+15 SET DIR(0)=DIR(0)_"E:DUPLICATE EIN+SUFFIX;"
+16 SET DIR(0)=DIR(0)_"B:DUPLICATE BANK ACCOUNTS;"
+17 SET DIR(0)=DIR(0)_"S:SUMMARY OF DUPLICATES;"
+18 SET DIR(0)=DIR(0)_"H:HELP"
+19 SET DIR("A")="UFMS DUPLICATE VENDOR INFORMATION REPORT"
+20 SET DIR("B")="S"
+21 KILL DA,ACROUT,ACRQUIT
+22 DO DIR^ACRFDIC
+23 IF $DATA(ACRQUIT)
QUIT
+24 ;Q:'"NDARTEBC"[Y
+25 IF '"NDARTEBSH"[Y
QUIT
+26 SET ACRFVY=Y
+27 SET (ZTRTN,ACRRTN)="SUM^ACRFUFM4"
+28 SET ZTDESC="VENDORS SUMMARY DIAGNOSIS"
+29 KILL ACRHFS,ACRDIR,ACRFILE
+30 SET ACR("HFS")=""
+31 DO ^ACRFZIS
+32 KILL ACR("HFS")
+33 IF $DATA(ACRHFS)
Begin DoDot:1
+34 SET ACRDIR=ZISH1
+35 SET ACRFILE=ZISH2
+36 DO SUM
+37 DO PROCHFS^ACRFVLK2
End DoDot:1
+38 QUIT
SUM ;EP - GATHER ACTIVE VENDORS MISSING DATA
+1 KILL ACRFV0,ACRFV11,ACRFV13,ACRFV19,ACRFVREC,ACROUT,ACRFVNAM
+2 SET X="VENDORS UFMS READINESS SUMMARY REPORT"
+3 DO EN^ACRFUFM2("")
+4 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+5 USE %FILE
+6 WRITE X,!
End DoDot:1
+7 IF '$TEST
WRITE !!?80-$LENGTH(X)/2,X
+8 SET Y=DT
XECUTE ^DD("DD")
+9 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+10 USE %FILE
+11 WRITE Y,!
End DoDot:1
+12 IF '$TEST
WRITE !?80-$LENGTH(X)/2,Y
+13 IF "N"[ACRFVY
DO HEAD1
+14 IF "D"[ACRFVY
DO HEAD2
+15 IF "A"[ACRFVY
DO HEAD3
+16 IF "R"[ACRFVY
DO HEAD4
+17 IF "T"[ACRFVY
DO HEAD5
+18 IF "E"[ACRFVY
DO HEAD6
+19 ;I "C"[ACRFVY D HEAD7
+20 IF "B"[ACRFVY
DO HEAD8
+21 IF "H"[ACRFVY
DO HEAD9
+22 IF "S"[ACRFVY
DO HEAD10
+23 SET (ACRFVREC,ACRFVXCT,ACRFVXT,ACRFVXN,ACRFVXD,ACRFVXA1)=0
+24 SET (ACRFVXR1,ACRFVXE1,ACRFVXE2)=0
+25 SET (ACRFVXB1,ACRFVXB2)=0
+26 FOR
SET ACRFVREC=$ORDER(^TMP("ACRAVEN",$JOB,ACRFVREC))
IF 'ACRFVREC!($DATA(ACROUT))
QUIT
Begin DoDot:1
+27 SET ACRFV0=$GET(^AUTTVNDR(ACRFVREC,0))
+28 IF $GET(ACRFV0)=""
QUIT
+29 SET ACRFV11=$GET(^AUTTVNDR(ACRFVREC,11))
+30 SET ACRFV13=$GET(^AUTTVNDR(ACRFVREC,13))
+31 SET ACRFV14=$GET(^AUTTVNDR(ACRFVREC,14))
+32 ;BANKING INFO
SET ACRFV19=$GET(^AUTTVNDR(ACRFVREC,19))
+33 SET ACRFVNAM=$PIECE(ACRFV0,U)
+34 ;TO GET TOTAL IN VENDOR FILE
SET ACRFVXT=ACRFVXT+1
+35 IF $PIECE(ACRFV0,U,5)=""
Begin DoDot:2
+36 SET ACRFVXCT=ACRFVXCT+1
+37 ;IF VENDOR HAS DUP NAME
+38 SET ACRFVX=$PIECE(ACRFV0,U,1)
Begin DoDot:3
+39 IF ACRFVX=""
QUIT
+40 IF $DATA(^TMP("ACR",$JOB,"NAM",ACRFVX))
Begin DoDot:4
+41 SET ACRFVXN=ACRFVXN+1
+42 SET ^TMP("ACR",$JOB,"NAMD",ACRFVREC)=ACRFVREC_U_ACRFVX
+43 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,"NAM",ACRFVX),U,1)
+44 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,"NAM",ACRFVX),U,2)
+45 SET ACRFVX3=$PIECE(^TMP("ACR",$JOB,"NAM",ACRFVX),U,3)
+46 SET ^TMP("ACR",$JOB,"NAMD",ACRFVX1)=ACRFVX2_U_ACRFVX3
End DoDot:4
+47 SET ^TMP("ACR",$JOB,"NAM",ACRFVX)=ACRFVREC_U_ACRFVREC_U_ACRFVX
End DoDot:3
+48 ;IF VENDOR HAS DUP DUNS
+49 SET ACRFVX=$PIECE(ACRFV0,U,7)
Begin DoDot:3
+50 IF ACRFVX=""
QUIT
+51 IF $DATA(^TMP("ACR",$JOB,"DUNS",ACRFVX))
Begin DoDot:4
+52 SET ACRFVXD=ACRFVXD+1
+53 SET ^TMP("ACR",$JOB,"DUND",ACRFVREC)=ACRFVNAM_U_ACRFVX
+54 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,"DUNS",ACRFVX),U,1)
+55 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,"DUNS",ACRFVX),U,2)
+56 SET ACRFVX3=$PIECE(^TMP("ACR",$JOB,"DUNS",ACRFVX),U,3)
+57 SET ^TMP("ACR",$JOB,"DUND",ACRFVX1)=ACRFVX2_U_ACRFVX3
End DoDot:4
+58 SET ^TMP("ACR",$JOB,"DUNS",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
End DoDot:3
+59 ;IF VENDOR HAS DUP ADDRESS LINE 1
+60 SET ACRFVX=$PIECE(ACRFV13,U,1)
Begin DoDot:3
+61 IF ACRFVX=""
QUIT
+62 IF $DATA(^TMP("ACR",$JOB,"AD1",ACRFVX))
Begin DoDot:4
+63 SET ACRFVXA1=ACRFVXA1+1
+64 SET ^TMP("ACR",$JOB,"AD1D",ACRFVREC)=ACRFVNAM_U_ACRFVX
+65 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,"AD1",ACRFVX),U,1)
+66 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,"AD1",ACRFVX),U,2)
+67 SET ACRFVX3=$PIECE(^TMP("ACR",$JOB,"AD1",ACRFVX),U,3)
+68 SET ^TMP("ACR",$JOB,"AD1D",ACRFVX1)=ACRFVX2_U_ACRFVX3
End DoDot:4
+69 SET ^TMP("ACR",$JOB,"AD1",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
End DoDot:3
+70 ;IF VENDOR HAS DUP REMIT ADDRESS LINE 1
+71 SET ACRFVX=$PIECE(ACRFV14,U,1)
Begin DoDot:3
+72 IF ACRFVX=""
QUIT
+73 IF $DATA(^TMP("ACR",$JOB,"RAD1",ACRFVX))
Begin DoDot:4
+74 SET ACRFVXR1=ACRFVXR1+1
+75 SET ^TMP("ACR",$JOB,"RAD1D",ACRFVREC)=ACRFVNAM_U_ACRFVX
+76 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,"RAD1",ACRFVX),U,1)
+77 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,"RAD1",ACRFVX),U,2)
+78 SET ACRFVX3=$PIECE(^TMP("ACR",$JOB,"RAD1",ACRFVX),U,3)
+79 SET ^TMP("ACR",$JOB,"RAD1D",ACRFVX1)=ACRFVX2_U_ACRFVX3
End DoDot:4
+80 SET ^TMP("ACR",$JOB,"RAD1",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
End DoDot:3
+81 ;IF VENDOR IS ACTIVE & EIN IS DUPLICATE
+82 SET ACRFVX=$PIECE(ACRFV11,U,1)
Begin DoDot:3
+83 IF ACRFVX=""
QUIT
+84 IF $DATA(^TMP("ACR",$JOB,"TIN",ACRFVX))
Begin DoDot:4
+85 SET ACRFVXE1=ACRFVXE1+1
+86 SET ^TMP("ACR",$JOB,"TIND",ACRFVREC)=ACRFVNAM_U_ACRFVX
+87 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,"TIN",ACRFVX),U,1)
+88 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,"TIN",ACRFVX),U,2)
+89 SET ACRFVX3=$PIECE(^TMP("ACR",$JOB,"TIN",ACRFVX),U,3)
+90 SET ^TMP("ACR",$JOB,"TIND",ACRFVX1)=ACRFVX2_U_ACRFVX3
End DoDot:4
+91 SET ^TMP("ACR",$JOB,"TIN",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
End DoDot:3
+92 ;IF VENDOR IS ACTIVE & EIN+SUFFIX IS DUPLICATE
+93 SET ACRFVX=$PIECE(ACRFV11,U,13)
Begin DoDot:3
+94 IF ACRFVX=""
QUIT
+95 IF $DATA(^TMP("ACR",$JOB,"EIN",ACRFVX))
Begin DoDot:4
+96 SET ACRFVXE2=ACRFVXE2+1
+97 SET ^TMP("ACR",$JOB,"EIND",ACRFVREC)=ACRFVNAM_U_ACRFVX
+98 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,"EIN",ACRFVX),U,1)
+99 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,"EIN",ACRFVX),U,2)
+100 SET ACRFVX3=$PIECE(^TMP("ACR",$JOB,"EIN",ACRFVX),U,3)
+101 SET ^TMP("ACR",$JOB,"EIND",ACRFVX1)=ACRFVX2_U_ACRFVX3
End DoDot:4
+102 SET ^TMP("ACR",$JOB,"EIN",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
End DoDot:3
+103 ;IF VENDOR IS ACTIVE & BANK INFO IS DUPLICATE
+104 ;ROUTING NUMBER
SET ACRFVXR=$PIECE(ACRFV19,U,2)
Begin DoDot:3
+105 IF ACRFVXR=""
QUIT
+106 ;ACCOUNT NUMBER
SET ACRFVXA=$PIECE(ACRFV19,U,3)
+107 ;COMBINE ROUTING AND ACCOUNT NUMBERS
SET ACRFVX=ACRFVXR_"-"_ACRFVXA
+108 IF $DATA(^TMP("ACR",$JOB,"BR1",ACRFVX))
Begin DoDot:4
+109 SET ACRFVXB1=ACRFVXB1+1
+110 SET ^TMP("ACR",$JOB,"BR1D",ACRFVREC)=ACRFVNAM_U_ACRFVX
+111 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,"BR1",ACRFVX),U,1)
+112 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,"BR1",ACRFVX),U,2)
+113 SET ACRFVX3=$PIECE(^TMP("ACR",$JOB,"BR1",ACRFVX),U,3)
+114 SET ^TMP("ACR",$JOB,"BR1D",ACRFVX1)=ACRFVX2_U_ACRFVX3
End DoDot:4
+115 SET ^TMP("ACR",$JOB,"BR1",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
End DoDot:3
+116 ;S ACRFVX=$P(ACRFV19,U,3) D
+117 ;.Q:ACRFVX=""
+118 ;.I $D(^TMP("ACR",$J,"BR2",ACRFVX)) D
+119 ;..S ACRFVXB2=ACRFVXB2+1
+120 ;..S ^TMP("ACR",$J,"BR2D",ACRFVREC)=ACRFVNAM_U_ACRFVX
+121 ;..S ACRFVX1=$P(^TMP("ACR",$J,"BR2",ACRFVX),U,1)
+122 ;..S ACRFVX2=$P(^TMP("ACR",$J,"BR2",ACRFVX),U,2)
+123 ;..S ACRFVX3=$P(^TMP("ACR",$J,"BR2",ACRFVX),U,3)
+124 ;..S ^TMP("ACR",$J,"BR2D",ACRFVX1)=ACRFVX2_U_ACRFVX3
+125 ;.S ^TMP("ACR",$J,"BR2",ACRFVX)=ACRFVREC_U_ACRFVNAM_U_ACRFVX
End DoDot:2
End DoDot:1
+126 ;
+127 SET ACRFVC=""
+128 SET ACRFVNAM=""
+129 SET ACRFVREC=""
+130 IF ACRFVY="N"
SET ACRFVC="NAMD"
+131 IF ACRFVY="D"
SET ACRFVC="DUND"
+132 IF ACRFVY="A"
SET ACRFVC="AD1D"
+133 IF ACRFVY="R"
SET ACRFVC="RAD1D"
+134 IF ACRFVY="T"
SET ACRFVC="TIND"
+135 IF ACRFVY="E"
SET ACRFVC="EIND"
+136 IF ACRFVY="B"
SET ACRFVC="BR1D"
+137 IF ACRFVY="S"
KILL ^TMP("ACR",$JOB)
DO BLDSUM
QUIT
+138 IF ACRFVY="H"
KILL ^TMP("ACR",$JOB)
DO HELP
QUIT
+139 SET ACRFVREC=""
+140 FOR
SET ACRFVREC=$ORDER(^TMP("ACR",$JOB,ACRFVC,ACRFVREC))
IF ACRFVREC=""!($DATA(ACROUT))
QUIT
Begin DoDot:1
+141 SET ACRFVX1=$PIECE(^TMP("ACR",$JOB,ACRFVC,ACRFVREC),U,1)
+142 SET ACRFVX2=$PIECE(^TMP("ACR",$JOB,ACRFVC,ACRFVREC),U,2)
+143 IF ACRFVX1=""
SET ACRFVX1="UNK1"
+144 IF ACRFVX2=""
SET ACRFVX2="UNK2"
+145 SET ^TMP("ACR",$JOB,"SORT",ACRFVX2,ACRFVX1,ACRFVREC)=""
End DoDot:1
+146 SET (ACRFVX1,ACRFVX2,ACRFVREC)=""
+147 FOR
SET ACRFVX2=$ORDER(^TMP("ACR",$JOB,"SORT",ACRFVX2))
IF ACRFVX2=""!($DATA(ACROUT))
QUIT
Begin DoDot:1
+148 SET ACRFVX1=""
FOR
SET ACRFVX1=$ORDER(^TMP("ACR",$JOB,"SORT",ACRFVX2,ACRFVX1))
IF ACRFVX1=""!($DATA(ACROUT))
QUIT
Begin DoDot:2
+149 SET ACRFVREC=""
FOR
SET ACRFVREC=$ORDER(^TMP("ACR",$JOB,"SORT",ACRFVX2,ACRFVX1,ACRFVREC))
IF ACRFVREC=""!($DATA(ACROUT))
QUIT
Begin DoDot:3
+150 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:4
+151 USE %FILE
+152 WRITE !,ACRFVX2_U_ACRFVX1
End DoDot:4
QUIT
+153 WRITE !,ACRFVX2,?34,ACRFVX1
+154 IF '$DATA(ACRHFS)
IF $Y>(IOSL-4)
DO PAUSE^ACRFWARN
WRITE @IOF
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+155 IF '$DATA(ACRHFS)
DO PAUSE^ACRFWARN
WRITE @IOF
+156 KILL ^TMP("ACR",$JOB)
+157 QUIT
BLDSUM ;BUILDS SUMMARY TMP GLOBAL
+1 SET ^TMP("ACR",$JOB,"1")="Active Vendors"_U_ACRFVXCT
+2 SET ^TMP("ACR",$JOB,"2")="Duplicate Names"_U_ACRFVXN
+3 SET ^TMP("ACR",$JOB,"3")="Duplicate DUNS"_U_ACRFVXD
+4 SET ^TMP("ACR",$JOB,"4")="Duplicate Address Line 1"_U_ACRFVXA1
+5 SET ^TMP("ACR",$JOB,"5")="Duplicate Remit Address Line 1"_U_ACRFVXR1
+6 SET ^TMP("ACR",$JOB,"6")="Duplicate EIN"_U_ACRFVXE1
+7 SET ^TMP("ACR",$JOB,"7")="Duplicate EIN_Suffix"_U_ACRFVXE2
+8 ;S ^TMP("ACR",$J,"8")="Duplicate Bank Routing"_U_ACRFVXB1
+9 ;S ^TMP("ACR",$J,"9")="Duplicate Bank Acct"_U_ACRFVXB2
+10 SET ^TMP("ACR",$JOB,"8")="Duplicate Bank Accounts"_U_ACRFVXB1
+11 SET ACRFVREC=""
FOR
SET ACRFVREC=$ORDER(^TMP("ACR",$JOB,ACRFVREC))
IF ACRFVREC=""!($DATA(ACROUT))
QUIT
Begin DoDot:1
+12 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:2
+13 USE %FILE
+14 WRITE !,^TMP("ACR",$JOB,ACRFVREC)
End DoDot:2
QUIT
+15 WRITE !,$PIECE(^TMP("ACR",$JOB,ACRFVREC),U,1),?34,$PIECE(^TMP("ACR",$JOB,ACRFVREC),U,2)
+16 IF '$DATA(ACRHFS)
IF $Y>(IOSL-4)
DO PAUSE^ACRFWARN
WRITE @IOF
QUIT
End DoDot:1
+17 IF '$DATA(ACRHFS)
DO PAUSE^ACRFWARN
WRITE @IOF
+18 KILL ^TMP("ACR",$JOB)
+19 QUIT
HEAD1 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE NAME"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE NAME",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD2 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE DUNS"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE DUNS",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD3 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE ADDRESS LINE 1"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE ADDRESS LINE 1",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD4 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE REMIT ADDRESS LINE 1"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE REMIT ADDRESS LINE 1",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD5 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE EIN"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE EIN",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD6 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE EIN+SUFFIX"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE EIN+SUFFIX",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD7 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE BANK ACCOUNTS"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE BANK ACCOUNTS",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD8 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE BANK ACCOUNTS"_U_"VENDOR IEN"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE BANK ACCOUNTS",?34,"VENDOR IEN"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD9 ;EP - HEADING3-if Help
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "Vendor DUPLICATE Help"_U_""
End DoDot:1
QUIT
+4 WRITE !,"Vendor DUPLICATE Help",?34,""
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HEAD10 ;EP - HEADING1 if detailed
+1 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:1
+2 USE %FILE
+3 WRITE "DUPLICATE SUMMARY"_U_"TOTAL"
End DoDot:1
QUIT
+4 WRITE !,"DUPLICATE SUMMARY",?34,"TOTAL"
+5 WRITE !,"-------------------------------------------------------------------------------"
+6 QUIT
HELP ;EP HELP INFORMATION FOR SUMMARY REPORT
+1 SET ^TMP("ACR",$JOB,"1")="The Code for each Vendor is grouped by dashes 0-0000-0000-0000-0000"
+2 SET ^TMP("ACR",$JOB,"2")="DUNS, Address, Remit Address, TAX ID Info, Bank Info, Misc Info"
+3 SET ^TMP("ACR",$JOB,"3")="If the Code is zero (0) the specific data appears to be good."
+4 SET ^TMP("ACR",$JOB,"4")="If the Code is numeric then the program has found a problem with the data"
+5 SET ^TMP("ACR",$JOB,"5")="First - number:DUNS 1=missing DUNS, 2=DUNS not 9 or 9+4 in length,"
+6 SET ^TMP("ACR",$JOB,"6")=" 4=DUNS contains alpha characters, 6 both of the above"
+7 SET ^TMP("ACR",$JOB,"7")="Second - Group:Address 1=address line 1 ,2=city, 3=state, 4=Zip code"
+8 SET ^TMP("ACR",$JOB,"8")=" Address Line 1: 1=missing"
+9 SET ^TMP("ACR",$JOB,"9")=" City: 1=missing"
+10 SET ^TMP("ACR",$JOB,"10")=" State: 1=missing"
+11 SET ^TMP("ACR",$JOB,"11")=" ZIP Code: 1=missing, 2=not 9 digits, 4=alpha char, 6=both"
+12 SET ^TMP("ACR",$JOB,"12")="Third - Group:Remit Address 1=address line 1,2=city,3=state,4=Zip code"
+13 SET ^TMP("ACR",$JOB,"13")=" Address Line 1: 1=missing"
+14 SET ^TMP("ACR",$JOB,"14")=" City: 1=missing"
+15 SET ^TMP("ACR",$JOB,"15")=" State: 1=missing"
+16 SET ^TMP("ACR",$JOB,"16")=" ZIP Code: 1=missing, 2=not 9 digits, 4=alpha char, 6=both"
+17 SET ^TMP("ACR",$JOB,"17")="Fourth - Group:Tax ID 1=EIN, 2=suffix, 3=proper EIN, 4=proper suffix"
+18 SET ^TMP("ACR",$JOB,"18")=" EIN: 1=missing"
+19 SET ^TMP("ACR",$JOB,"19")=" Suffix: 1=missing"
+20 SET ^TMP("ACR",$JOB,"20")=" EIN Info: 1=not 10 digits, 2=first digit not 1 or 2, 4=contains alpha"
+21 SET ^TMP("ACR",$JOB,"21")=" Suffix Info: 1=not 2 in length, 2=first not alpha, 4=second not numeric"
+22 SET ^TMP("ACR",$JOB,"22")="Fifth - Group:Bank ID 1=Type, 2=Routing, 3=Account, 4=Routing CheckSum"
+23 SET ^TMP("ACR",$JOB,"23")=" Type: 1=missing"
+24 SET ^TMP("ACR",$JOB,"24")=" Routing: 1=missing"
+25 SET ^TMP("ACR",$JOB,"25")=" Account: 1=missing"
+26 SET ^TMP("ACR",$JOB,"26")=" CheckSum: 1=not valid, 2=not 9 digits, 4=contains alpha char"
+27 SET ACRFVREC=""
FOR
SET ACRFVREC=$ORDER(^TMP("ACR",$JOB,ACRFVREC))
IF ACRFVREC=""!($DATA(ACROUT))
QUIT
Begin DoDot:1
+28 IF $DATA(ACRHFS)&($DATA(%FILE))
Begin DoDot:2
+29 USE %FILE
+30 WRITE !,^TMP("ACR",$JOB,ACRFVREC)
End DoDot:2
QUIT
+31 WRITE !,$PIECE(^TMP("ACR",$JOB,ACRFVREC),U,1),?34,$PIECE(^TMP("ACR",$JOB,ACRFVREC),U,2)
+32 IF '$DATA(ACRHFS)
IF $Y>(IOSL-4)
DO PAUSE^ACRFWARN
WRITE @IOF
QUIT
End DoDot:1
+33 IF '$DATA(ACRHFS)
DO PAUSE^ACRFWARN
WRITE @IOF
+34 KILL ^TMP("ACR",$JOB)
+35 QUIT
