AUTTVNDR.m

AUTTVNDR ; IHS/DIRM/JDM/DFM - CHECK FOR VENDOR FILE DUPLICATES; [ 10/06/2006   8:10 AM ]

 ;;98.1;IHS DICTIONARIES (POINTERS);**21**;MAR 04, 1998;Build 6

 ;

NAME ;EP;Called from ^DD(9999999.11,.01,"LAYGO",1,0)

 Q:$G(DIC(0))'["L"&($G(DLAYGO)'=9999999.11)&($G(DIE)'["AUTTVNDR")

 W !!,"Checking VENDOR NAME for matches.",!

 NEW AUT1,AUT2,AUT3

 S AUT3=X,X=$$^AUTTVND1(AUT3),(AUT1,AUT2)=0

 F  S AUT1=$O(^AUTTVNDR("ASX",X,AUT1)) Q:AUT1'>0  D W

 F AUTJ=1:1 S AUTX=$P(AUT3," ",AUTJ) Q:AUTX=""&($P(AUT3," ",AUTJ+1,9999)="")!$D(AUTQUIT)  D FIND

 KILL AUTJ

 I 'AUT2 W !,"No matches found.",! S AUT2=1 G L3

L2 ;

 W !!,"Do you still want to ",$S($G(DIC(0))'["L"&($G(DLAYGO)'=9999999.11):"make this change",1:"add this entry"),": NO//"

 R AUT2:300

 S AUT2=$TR($E(AUT2_"N"),"NnYy^?","00110?")

 I "01"'[AUT2 W !!?4,"Answer NO to stop the addition of ",AUT3," as a new VENDOR.",!?4,"Answer YES to add, a '^' will be taken as a NO." G L2

L3 ;

 S X=AUT3

 KILL:AUT2'=1 X

 I AUT2

 W !

 Q

 ;

EIN ;EP;CALL WHEN EIN NO. IS EDITED TO CHECK FOR EIN MATCHES

 Q:$D(DDS)&($G(DDS)["ACR")

 Q:$G(DIE)'["AUTTVNDR"

 W !!,"Checking VENDOR EIN for matches.",!

 NEW AUT1,AUT2,AUT3

 S AUT3=X,AUT2=0

 F AUT1=0:0 S AUT1=$O(^AUTTVNDR("C",X,AUT1)) Q:AUT1'>0!(AUT1=$G(DA))  D W

 I 'AUT2 W !,"No matches found." S AUT2=1 G E3

E2 ;

 W !!,"Do you still want to ",$S($G(DIC(0))'["L"&($G(DLAYGO)'=9999999.11):"enter this EIN",1:"add this entry"),": NO//"

 R AUT2:300

 S AUT2=$TR($E(AUT2_"N"),"NnYy^?","00110?")

 I "01"'[AUT2 W !!?4,"Answer NO to stop the addition of ",AUT3," as a new VENDOR.",!?4,"Answer YES to add, a '^' will be taken as a NO." G E2

E3 ;

 S X=AUT3

 KILL:AUT2'=1 X

 I AUT2

 W !

 Q

 ;

SUFFIX ;EP;TO CHECK EIN SUFFICES FOR MATCHES WITH EXISTING VENDORS

 Q:$G(DIE)'["AUTTVNDR"

 W !!,"Checking VENDOR EIN including SUFFIX for matches.",!

 NEW AUT1,AUT2,AUT3

 S AUT3=X,AUT2=0,X=$P($G(^AUTTVNDR(DA,11)),"^")_X

 F AUT1=0:0 S AUT1=$O(^AUTTVNDR("E",X,AUT1)) Q:AUT1'>0  W !?5,$P($G(^AUTTVNDR(AUT1,0)),"^"),?40,$P($G(^AUTTVNDR(AUT1,11)),"^",13) S AUT2=AUT2+1

 I 'AUT2 W !,"No matches found." S AUT2=1 G S3

S2 ;

 I $G(DIE)="^AUTTVNDR(" D

 .W !!,"You cannot create a new VENDOR file entry which has the exact same",!,"EIN and EIN SUFFIX as an existing VENDOR.  Enter the correct SUFFIX for this VENDOR.",!!,"Press <RETURN> to continue.. "

 .R AUT2:300

 .Q

 S AUT2="^"

S3 ;

 S X=AUT3

 KILL:AUT2'=1 X

 I AUT2

 W !

 Q

 ;

FIND ;

 S AUTX=$TR(AUTX,"!@#$%^&*()-_=+[{]}\|':;,<.>/?`~",""),AUTX=$TR(AUTX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 Q:"^A^AN^AND^OF^THE^INC^CORP^COMP^"[(U_AUTX_U)

 S:$A($E(AUTX,$L(AUTX)))>65 AUTZ=$E(AUTX,1,$L(AUTX)-1)_$C($A($E(AUTX,$L(AUTX)))-1)_"z"

 S:$E(AUTX,$L(AUTX)) AUTZ=$E(AUTX,1,$L(AUTX)-1)_($E(AUTX,$L(AUTX))-1)

 Q:$G(AUTZ)=""

 F  S AUTZ=$O(^AUTTVNDR("G",AUTZ)) Q:AUTZ=""!(AUTZ'[AUTX)!$D(AUTQUIT)  D

 .S AUT1=0

 .F  S AUT1=$O(^AUTTVNDR("G",AUTZ,AUT1)) Q:'AUT1!$D(AUTQUIT)  D W,R:AUT2#10=0

 .Q

 KILL AUTQUIT

 Q

 ;

W ;

 W !?5

 W:$G(AUTX)]""&($G(AUTX)'=$P($G(^AUTTVNDR(AUT1,0)),"^")) AUTX,?$X+3

 W $P($G(^AUTTVNDR(AUT1,0)),"^"),?40+$S($L($G(AUTX))<16:$L($G(AUTX)),1:15)," ",$P($G(^AUTTVNDR(AUT1,11)),"^",13) S AUT2=AUT2+1

 Q

 ;

R ;

 R !,"Press <RETURN> to continue, '^' to exit ",Z:300

 S:$E(Z)="^" AUTQUIT=""

 Q

 ;

AUTTVNDR  ; IHS/DIRM/JDM/DFM - CHECK FOR VENDOR FILE DUPLICATES; [ 10/06/2006   8:10 AM ]

 +1       ;;98.1;IHS DICTIONARIES (POINTERS);**21**;MAR 04, 1998;Build 6

 +2       ;

NAME      ;EP;Called from ^DD(9999999.11,.01,"LAYGO",1,0)

 +1        IF $GET(DIC(0))'["L"&($GET(DLAYGO)'=9999999.11)&($GET(DIE)'["AUTTVNDR")

               QUIT 

 +2        WRITE !!,"Checking VENDOR NAME for matches.",!

 +3        NEW AUT1,AUT2,AUT3

 +4        SET AUT3=X

           SET X=$$^AUTTVND1(AUT3)

           SET (AUT1,AUT2)=0

 +5        FOR 

               SET AUT1=$ORDER(^AUTTVNDR("ASX",X,AUT1))

               IF AUT1'>0

                   QUIT 

               DO W

 +6        FOR AUTJ=1:1

               SET AUTX=$PIECE(AUT3," ",AUTJ)

               IF AUTX=""&($PIECE(AUT3," ",AUTJ+1,9999)="")!$DATA(AUTQUIT)

                   QUIT 

               DO FIND

 +7        KILL AUTJ

 +8        IF 'AUT2

               WRITE !,"No matches found.",!

               SET AUT2=1

               GOTO L3

L2        ;

 +1        WRITE !!,"Do you still want to ",$SELECT($GET(DIC(0))'["L"&($GET(DLAYGO)'=9999999.11):"make this change",1:"add this entry"),": NO//"

 +2        READ AUT2:300

 +3        SET AUT2=$TRANSLATE($EXTRACT(AUT2_"N"),"NnYy^?","00110?")

 +4        IF "01"'[AUT2

               WRITE !!?4,"Answer NO to stop the addition of ",AUT3," as a new VENDOR.",!?4,"Answer YES to add, a '^' will be taken as a NO."

               GOTO L2

L3        ;

 +1        SET X=AUT3

 +2        IF AUT2'=1

               KILL X

 +3        IF AUT2

 +4        WRITE !

 +5        QUIT 

 +6       ;

EIN       ;EP;CALL WHEN EIN NO. IS EDITED TO CHECK FOR EIN MATCHES

 +1        IF $DATA(DDS)&($GET(DDS)["ACR")

               QUIT 

 +2        IF $GET(DIE)'["AUTTVNDR"

               QUIT 

 +3        WRITE !!,"Checking VENDOR EIN for matches.",!

 +4        NEW AUT1,AUT2,AUT3

 +5        SET AUT3=X

           SET AUT2=0

 +6        FOR AUT1=0:0

               SET AUT1=$ORDER(^AUTTVNDR("C",X,AUT1))

               IF AUT1'>0!(AUT1=$GET(DA))

                   QUIT 

               DO W

 +7        IF 'AUT2

               WRITE !,"No matches found."

               SET AUT2=1

               GOTO E3

E2        ;

 +1        WRITE !!,"Do you still want to ",$SELECT($GET(DIC(0))'["L"&($GET(DLAYGO)'=9999999.11):"enter this EIN",1:"add this entry"),": NO//"

 +2        READ AUT2:300

 +3        SET AUT2=$TRANSLATE($EXTRACT(AUT2_"N"),"NnYy^?","00110?")

 +4        IF "01"'[AUT2

               WRITE !!?4,"Answer NO to stop the addition of ",AUT3," as a new VENDOR.",!?4,"Answer YES to add, a '^' will be taken as a NO."

               GOTO E2

E3        ;

 +1        SET X=AUT3

 +2        IF AUT2'=1

               KILL X

 +3        IF AUT2

 +4        WRITE !

 +5        QUIT 

 +6       ;

SUFFIX    ;EP;TO CHECK EIN SUFFICES FOR MATCHES WITH EXISTING VENDORS

 +1        IF $GET(DIE)'["AUTTVNDR"

               QUIT 

 +2        WRITE !!,"Checking VENDOR EIN including SUFFIX for matches.",!

 +3        NEW AUT1,AUT2,AUT3

 +4        SET AUT3=X

           SET AUT2=0

           SET X=$PIECE($GET(^AUTTVNDR(DA,11)),"^")_X

 +5        FOR AUT1=0:0

               SET AUT1=$ORDER(^AUTTVNDR("E",X,AUT1))

               IF AUT1'>0

                   QUIT 

               WRITE !?5,$PIECE($GET(^AUTTVNDR(AUT1,0)),"^"),?40,$PIECE($GET(^AUTTVNDR(AUT1,11)),"^",13)

               SET AUT2=AUT2+1

 +6        IF 'AUT2

               WRITE !,"No matches found."

               SET AUT2=1

               GOTO S3

S2        ;

 +1        IF $GET(DIE)="^AUTTVNDR("

               Begin DoDot:1

 +2                WRoutine_AUTTVNDR_source.html#xR">Routine_AUTTVNDRoutine_AUTTVNDR_source.html#xR">R_source.html#xRoutine_AUTTVNDR_source.html#xR">R">Routine_AUTTVNDR_source.html#xR">RITE !!,"You cannot create a new VENDORoutine_AUTTVNDR_source.html#xR">Routine_AUTTVNDRoutine_AUTTVNDR_source.html#xR">R_source.html#xRoutine_AUTTVNDR_source.html#xR">R">Routine_AUTTVNDR_source.html#xR">R file entry which has the exact same",!,"EIN and EIN SUFFIX as an existing VENDORoutine_AUTTVNDR_source.html#xR">Routine_AUTTVNDRoutine_AUTTVNDR_source.html#xR">R_source.html#xRoutine_AUTTVNDR_source.html#xR">R">Routine_AUTTVNDR_source.html#xR">R.  Enter the correct SUFFIX for this VENDORoutine_AUTTVNDR_source.html#xR">Routine_AUTTVNDRoutine_AUTTVNDR_source.html#xR">R_source.html#xRoutine_AUTTVNDR_source.html#xR">R">Routine_AUTTVNDR_source.html#xR">R.",!!,"Press <Routine_AUTTVNDR_source.html#xR">Routine_AUTTVNDRoutine_AUTTVNDR_source.html#xR">R_source.html#xRoutine_AUTTVNDR_source.html#xR">R">Routine_AUTTVNDR_source.html#xR">RETURoutine_AUTTVNDR_source.html#xR">Routine_AUTTVNDRoutine_AUTTVNDR_source.html#xR">R_source.html#xRoutine_AUTTVNDR_source.html#xR">R">Routine_AUTTVNDR_source.html#xR">RN> to continue.. "

 +3                READ AUT2:300

 +4                QUIT 

               End DoDot:1

 +5        SET AUT2="^"

S3        ;

 +1        SET X=AUT3

 +2        IF AUT2'=1

               KILL X

 +3        IF AUT2

 +4        WRITE !

 +5        QUIT 

 +6       ;

FIND      ;

 +1        SET AUTX=$TRANSLATE(AUTX,"!@#$%^&*()-_=+[{]}\|':;,<.>/?`~","")

           SET AUTX=$TRANSLATE(AUTX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +2        IF "^A^AN^AND^OF^THE^INC^CORP^COMP^"[(U_AUTX_U)

               QUIT 

 +3        IF $ASCII($EXTRACT(AUTX,$LENGTH(AUTX)))>65

               SET AUTZ=$EXTRACT(AUTX,1,$LENGTH(AUTX)-1)_$CHAR($ASCII($EXTRACT(AUTX,$LENGTH(AUTX)))-1)_"z"

 +4        IF $EXTRACT(AUTX,$LENGTH(AUTX))

               SET AUTZ=$EXTRACT(AUTX,1,$LENGTH(AUTX)-1)_($EXTRACT(AUTX,$LENGTH(AUTX))-1)

 +5        IF $GET(AUTZ)=""

               QUIT 

 +6        FOR 

               SET AUTZ=$ORDER(^AUTTVNDR("G",AUTZ))

               IF AUTZ=""!(AUTZ'[AUTX)!$DATA(AUTQUIT)

                   QUIT 

               Begin DoDot:1

 +7                SET AUT1=0

 +8                FOR 

                       SET AUT1=$ORDER(^AUTTVNDR("G",AUTZ,AUT1))

                       IF 'AUT1!$DATA(AUTQUIT)

                           QUIT 

                       DO W

                       IF AUT2#10=0

                           DO R

 +9                QUIT 

               End DoDot:1

 +10       KILL AUTQUIT

 +11       QUIT 

 +12      ;

W         ;

 +1        WRITE !?5

 +2        IF $GET(AUTX)]""&($GET(AUTX)'=$PIECE($GET(^AUTTVNDR(AUT1,0)),"^"))

               WRITE AUTX,?$X+3

 +3        WRITE $PIECE($GET(^AUTTVNDR(AUT1,0)),"^"),?40+$SELECT($LENGTH($GET(AUTX))<16:$LENGTH($GET(AUTX)),1:15)," ",$PIECE($GET(^AUTTVNDR(AUT1,11)),"^",13)

           SET AUT2=AUT2+1

 +4        QUIT 

 +5       ;

R         ;

 +1        READ !,"Press <RETURN> to continue, '^' to exit ",Z:300

 +2        IF $EXTRACT(Z)="^"

               SET AUTQUIT=""

 +3        QUIT 

 +4       ;