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 ;
