ESP117PT ;ALB/CJM - ESP *1*17 POST-INSTALL ROUTINE [9/30/96 12:08pm]
;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
;
START ;
D SSNRPT ;report on duplicate SSN's
D SNDXCHG ;fix soundex x-ref on file 910
D IDNTFR ;to update multiple 916.05 headers
D NEWXREFS ;cross-references files on new x-refs
Q
;
;
SSNRPT ;
;lists duplicate SSN's allowed by faulty input transform
;
N SSN,NAME,IEN,TEXT,FLAG
D BMES^XPDUTL("...Searching for duplicate SSNs in file #910")
S TEXT="IEN SSN",$E(TEXT,46)="NAME" D MES^XPDUTL(TEXT)
S TEXT="=== ====",$E(TEXT,46)="===" D MES^XPDUTL(TEXT)
S (FLAG,SSN)=""
F S SSN=$O(^ESP(910,"SSN",SSN)) Q:SSN="" D
.S IEN=$O(^ESP(910,"SSN",SSN,0))
.Q:'IEN
.I $O(^ESP(910,"SSN",SSN,IEN)) D MES^XPDUTL("") F Q:'IEN D S IEN=$O(^ESP(910,"SSN",SSN,IEN))
..S FLAG=1
..S NAME=$P($G(^ESP(910,IEN,0)),"^")
..S TEXT=IEN,$E(TEXT,10)="",TEXT=TEXT_SSN,$E(TEXT,46)="",TEXT=TEXT_NAME
..D MES^XPDUTL(TEXT)
D:FLAG MES^XPDUTL("")
D:'FLAG MES^XPDUTL(" **** NO DUPLICATE SSN ENTRIES WERE FOUND **** ")
D MES^XPDUTL("...Duplicate entry search Completed.")
Q
;
SNDXCHG ;fixes the SOUN x-ref on file 910
;
N DIK,DA
D BMES^XPDUTL("...Deleting non-Fileman soundex x-ref on file #910")
K ^ESP(910,"SOUN")
D MES^XPDUTL("...Creating FileMan soundex x-ref on file #910")
S DIK="^ESP(910,",DIK(1)=".01^SOUN" D ENALL^DIK
Q
;
IDNTFR ;
;add I to all time multiple headers in file 916
N JRNL
S JRNL=0
D BMES^XPDUTL("...Adding identifiers to subfile #916.05")
F S JRNL=$O(^ESP(916,JRNL)) Q:'JRNL I $D(^ESP(916,JRNL,4,0)) D
.S $P(^ESP(916,JRNL,4,0),U,2)="916.05I"
Q
;
NEWXREFS ;
;cross references files on new x-refs added by patch
;
N DIK,DA
D BMES^XPDUTL("...Creating FileMan ""I"" x-ref on file #910.2")
S DIK="^ESP(910.2,",DIK(1)="4.05^I" D ENALL^DIK
;
D BMES^XPDUTL("...Creating FileMan ""J"" x-ref on file #910.2")
K DIK S DIK="^ESP(910.2,",DIK(1)="5.01^J" D ENALL^DIK
;
D BMES^XPDUTL("...Creating FileMan ""J"" x-ref on file #912.09")
K DA
S DA(1)=0
F S DA(1)=$O(^ESP(912,DA(1))) Q:'DA(1) D
.Q:'$D(^ESP(912,DA(1),80))
.S DA="",DIK="^ESP(912,"_DA(1)_",80,",DIK(1)=".11^J" D ENALL^DIK
;
D BMES^XPDUTL("...Creating FileMan ""D"" x-ref on file #910.85")
K DA
S DA(1)=0
F S DA(1)=$O(^ESP(910.8,DA(1))) Q:'DA(1) D
.Q:'$D(^ESP(910.8,DA(1),5))
.S DA="",DIK="^ESP(910.8,"_DA(1)_",5,",DIK(1)=".03^D" D ENALL^DIK
Q
;
SSNDUP ; entry point to run ssn duplicate report.
N POP
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
. S ZTRTN="SSNRPT^ESP117PT",ZTDESC="DUP SSN REPORT ON #910"
. D ^%ZTLOAD
. D HOME^%ZIS K IO("Q") Q
U IO
D SSNRPT
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESP117PT 2697 printed Apr 09, 2024@21:33:15 Page 2
ESP117PT ;ALB/CJM - ESP *1*17 POST-INSTALL ROUTINE [9/30/96 12:08pm]
+1 ;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
+2 ;
START ;
+1 ;report on duplicate SSN's
DO SSNRPT
+2 ;fix soundex x-ref on file 910
DO SNDXCHG
+3 ;to update multiple 916.05 headers
DO IDNTFR
+4 ;cross-references files on new x-refs
DO NEWXREFS
+5 QUIT
+6 ;
+7 ;
SSNRPT ;
+1 ;lists duplicate SSN's allowed by faulty input transform
+2 ;
+3 NEW SSN,NAME,IEN,TEXT,FLAG
+4 DO BMES^XPDUTL("...Searching for duplicate SSNs in file #910")
+5 SET TEXT="IEN SSN"
SET $EXTRACT(TEXT,46)="NAME"
DO MES^XPDUTL(TEXT)
+6 SET TEXT="=== ===="
SET $EXTRACT(TEXT,46)="==="
DO MES^XPDUTL(TEXT)
+7 SET (FLAG,SSN)=""
+8 FOR
SET SSN=$ORDER(^ESP(910,"SSN",SSN))
if SSN=""
QUIT
Begin DoDot:1
+9 SET IEN=$ORDER(^ESP(910,"SSN",SSN,0))
+10 if 'IEN
QUIT
+11 IF $ORDER(^ESP(910,"SSN",SSN,IEN))
DO MES^XPDUTL("")
FOR
if 'IEN
QUIT
Begin DoDot:2
+12 SET FLAG=1
+13 SET NAME=$PIECE($GET(^ESP(910,IEN,0)),"^")
+14 SET TEXT=IEN
SET $EXTRACT(TEXT,10)=""
SET TEXT=TEXT_SSN
SET $EXTRACT(TEXT,46)=""
SET TEXT=TEXT_NAME
+15 DO MES^XPDUTL(TEXT)
End DoDot:2
SET IEN=$ORDER(^ESP(910,"SSN",SSN,IEN))
End DoDot:1
+16 if FLAG
DO MES^XPDUTL("")
+17 if 'FLAG
DO MES^XPDUTL(" **** NO DUPLICATE SSN ENTRIES WERE FOUND **** ")
+18 DO MES^XPDUTL("...Duplicate entry search Completed.")
+19 QUIT
+20 ;
SNDXCHG ;fixes the SOUN x-ref on file 910
+1 ;
+2 NEW DIK,DA
+3 DO BMES^XPDUTL("...Deleting non-Fileman soundex x-ref on file #910")
+4 KILL ^ESP(910,"SOUN")
+5 DO MES^XPDUTL("...Creating FileMan soundex x-ref on file #910")
+6 SET DIK="^ESP(910,"
SET DIK(1)=".01^SOUN"
DO ENALL^DIK
+7 QUIT
+8 ;
IDNTFR ;
+1 ;add I to all time multiple headers in file 916
+2 NEW JRNL
+3 SET JRNL=0
+4 DO BMES^XPDUTL("...Adding identifiers to subfile #916.05")
+5 FOR
SET JRNL=$ORDER(^ESP(916,JRNL))
if 'JRNL
QUIT
IF $DATA(^ESP(916,JRNL,4,0))
Begin DoDot:1
+6 SET $PIECE(^ESP(916,JRNL,4,0),U,2)="916.05I"
End DoDot:1
+7 QUIT
+8 ;
NEWXREFS ;
+1 ;cross references files on new x-refs added by patch
+2 ;
+3 NEW DIK,DA
+4 DO BMES^XPDUTL("...Creating FileMan ""I"" x-ref on file #910.2")
+5 SET DIK="^ESP(910.2,"
SET DIK(1)="4.05^I"
DO ENALL^DIK
+6 ;
+7 DO BMES^XPDUTL("...Creating FileMan ""J"" x-ref on file #910.2")
+8 KILL DIK
SET DIK="^ESP(910.2,"
SET DIK(1)="5.01^J"
DO ENALL^DIK
+9 ;
+10 DO BMES^XPDUTL("...Creating FileMan ""J"" x-ref on file #912.09")
+11 KILL DA
+12 SET DA(1)=0
+13 FOR
SET DA(1)=$ORDER(^ESP(912,DA(1)))
if 'DA(1)
QUIT
Begin DoDot:1
+14 if '$DATA(^ESP(912,DA(1),80))
QUIT
+15 SET DA=""
SET DIK="^ESP(912,"_DA(1)_",80,"
SET DIK(1)=".11^J"
DO ENALL^DIK
End DoDot:1
+16 ;
+17 DO BMES^XPDUTL("...Creating FileMan ""D"" x-ref on file #910.85")
+18 KILL DA
+19 SET DA(1)=0
+20 FOR
SET DA(1)=$ORDER(^ESP(910.8,DA(1)))
if 'DA(1)
QUIT
Begin DoDot:1
+21 if '$DATA(^ESP(910.8,DA(1),5))
QUIT
+22 SET DA=""
SET DIK="^ESP(910.8,"_DA(1)_",5,"
SET DIK(1)=".03^D"
DO ENALL^DIK
End DoDot:1
+23 QUIT
+24 ;
SSNDUP ; entry point to run ssn duplicate report.
+1 NEW POP
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="SSNRPT^ESP117PT"
SET ZTDESC="DUP SSN REPORT ON #910"
+5 DO ^%ZTLOAD
+6 DO HOME^%ZIS
KILL IO("Q")
QUIT
End DoDot:1
QUIT
+7 USE IO
+8 DO SSNRPT
+9 DO ^%ZISC
+10 QUIT
