- 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 Feb 18, 2025@23:55:58 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