ESPXREF ;DALISC/CKA - SOUNDEX;10/92
;;1.0;POLICE & SECURITY;;Mar 31, 1994
S ESPSOUN=$$SOUN^ESPSOUN($P(X,","))_$$SOUN^ESPSOUN($E($P(X,",",2),1,3))
QUIT
LAYGO ;Called from ^DD(910,.01,"LAYGO",1,0);extracted from Kernel routine XUA4A7
Q:DIC(0)'["E"
W !,"Checking SOUNDEX for matches."
N XU1,XU2,XU3 S XU3=X
S X=$$SOUN^ESPSOUN($P(XU3,","))_$$SOUN^ESPSOUN($E($P(XU3,",",2),1,3)),XU2=0 ;D ^ESPSOUN
F XU1=0:0 S XU1=$O(^ESP(910,"SOUN",X,XU1)) Q:XU1'>0 W !?5,$P($G(^ESP(910,XU1,0)),"^") S XU2=XU2+1
I 'XU2 W !,"No matches found." S XU2=1 G L3
L2 R !,"Do you still want to add this entry: NO//",XU2:DTIME S:'$T ESPOUT=1 S XU2=$TR($E(XU2_"N"),"NnYy^?","00110?")
I "01"'[XU2 W !?4,"Answer NO to stop the addition of ",XU3," as a new master name index person.",!?4,"Answer YES to add, a '^' will be taken as a NO." G L2
L3 S X=XU2
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPXREF 851 printed Dec 13, 2024@02:31:02 Page 2
ESPXREF ;DALISC/CKA - SOUNDEX;10/92
+1 ;;1.0;POLICE & SECURITY;;Mar 31, 1994
+2 SET ESPSOUN=$$SOUN^ESPSOUN($PIECE(X,","))_$$SOUN^ESPSOUN($EXTRACT($PIECE(X,",",2),1,3))
+3 QUIT
LAYGO ;Called from ^DD(910,.01,"LAYGO",1,0);extracted from Kernel routine XUA4A7
+1 if DIC(0)'["E"
QUIT
+2 WRITE !,"Checking SOUNDEX for matches."
+3 NEW XU1,XU2,XU3
SET XU3=X
+4 ;D ^ESPSOUN
SET X=$$SOUN^ESPSOUN($PIECE(XU3,","))_$$SOUN^ESPSOUN($EXTRACT($PIECE(XU3,",",2),1,3))
SET XU2=0
+5 FOR XU1=0:0
SET XU1=$ORDER(^ESP(910,"SOUN",X,XU1))
if XU1'>0
QUIT
WRITE !?5,$PIECE($GET(^ESP(910,XU1,0)),"^")
SET XU2=XU2+1
+6 IF 'XU2
WRITE !,"No matches found."
SET XU2=1
GOTO L3
L2 READ !,"Do you still want to add this entry: NO//",XU2:DTIME
if '$TEST
SET ESPOUT=1
SET XU2=$TRANSLATE($EXTRACT(XU2_"N"),"NnYy^?","00110?")
+1 IF "01"'[XU2
WRITE !?4,"Answer NO to stop the addition of ",XU3," as a new master name index person.",!?4,"Answer YES to add, a '^' will be taken as a NO."
GOTO L2
L3 SET X=XU2
+1 QUIT
