ACRFUFM4.m

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))