IVM2193P ;ALB/JAM - IVM*2.0*193 PRE-INSTALL ROUTINE ;3/31/2020 3:21pm
 ;;2.0;INCOME VERIFICATION MATCH;**193**;21-OCT-94;Build 37
 ;
 ;Clean up 301.92 file (IVM DEMOGRAPHIC UPLOAD FIELDS) - remove IENs over 150 if patch 941 had been installed more than once
 ;and patch IVM 193 has not already been installed.
 ;
 ; IAs:
 ;  BMES^XPDUTL, MES^XPDUTL, INSTALDT^XPDUTL:  Supported by IA #10141
 Q
EP ; Entry Point
 D BMES^XPDUTL(">>> Cleanup of IENs in IVM DEMOGRAPHIC UPLOAD FIELDS file (#301.92)...")
 ;
 ; No need for cleanup if patch IVM 193 has already been installed
 I $$INSTALDT^XPDUTL("IVM*2.0*193") D MES^XPDUTL(" Patch IVM*2.0*193 previously installed - cleanup not needed.") Q
 ;
 N IVMX,IVMRESULT
 ; No need for cleanup if patch 941 has been installed only once
 S IVMX=$$INSTALDT^XPDUTL("DG*5.3*941",.IVMRESULT)
 I IVMRESULT=1 D MES^XPDUTL(" Patch DG*5.3*941 not installed multiple times - cleanup not needed.") Q
 ;
 N IVMIEN,IVMNUM
 ; sweep through 301.92 file removing any IENs above 150 (PHONE NUMBER [WORK])
 S IVMNUM=0,IVMIEN=150
 F  S IVMIEN=$O(^IVM(301.92,IVMIEN)) Q:'IVMIEN  D
 . S IVMNUM=IVMNUM+1
 . ; remove the IEN from the file
 . S DA=IVMIEN,DIK="^IVM(301.92," D ^DIK K DA,DIK
 D MES^XPDUTL(" Cleanup is complete.")
 D MES^XPDUTL(" Number of IENs removed:"_IVMNUM)
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM2193P   1323     printed  Sep 23, 2025@19:36:15                                                                                                                                                                                                    Page 2
IVM2193P  ;ALB/JAM - IVM*2.0*193 PRE-INSTALL ROUTINE ;3/31/2020 3:21pm
 +1       ;;2.0;INCOME VERIFICATION MATCH;**193**;21-OCT-94;Build 37
 +2       ;
 +3       ;Clean up 301.92 file (IVM DEMOGRAPHIC UPLOAD FIELDS) - remove IENs over 150 if patch 941 had been installed more than once
 +4       ;and patch IVM 193 has not already been installed.
 +5       ;
 +6       ; IAs:
 +7       ;  BMES^XPDUTL, MES^XPDUTL, INSTALDT^XPDUTL:  Supported by IA #10141
 +8        QUIT 
EP        ; Entry Point
 +1        DO BMES^XPDUTL(">>> Cleanup of IENs in IVM DEMOGRAPHIC UPLOAD FIELDS file (#301.92)...")
 +2       ;
 +3       ; No need for cleanup if patch IVM 193 has already been installed
 +4        IF $$INSTALDT^XPDUTL("IVM*2.0*193")
               DO MES^XPDUTL(" Patch IVM*2.0*193 previously installed - cleanup not needed.")
               QUIT 
 +5       ;
 +6        NEW IVMX,IVMRESULT
 +7       ; No need for cleanup if patch 941 has been installed only once
 +8        SET IVMX=$$INSTALDT^XPDUTL("DG*5.3*941",.IVMRESULT)
 +9        IF IVMRESULT=1
               DO MES^XPDUTL(" Patch DG*5.3*941 not installed multiple times - cleanup not needed.")
               QUIT 
 +10      ;
 +11       NEW IVMIEN,IVMNUM
 +12      ; sweep through 301.92 file removing any IENs above 150 (PHONE NUMBER [WORK])
 +13       SET IVMNUM=0
           SET IVMIEN=150
 +14       FOR 
               SET IVMIEN=$ORDER(^IVM(301.92,IVMIEN))
               if 'IVMIEN
                   QUIT 
               Begin DoDot:1
 +15               SET IVMNUM=IVMNUM+1
 +16      ; remove the IEN from the file
 +17               SET DA=IVMIEN
                   SET DIK="^IVM(301.92,"
                   DO ^DIK
                   KILL DA,DIK
               End DoDot:1
 +18       DO MES^XPDUTL(" Cleanup is complete.")
 +19       DO MES^XPDUTL(" Number of IENs removed:"_IVMNUM)
 +20       QUIT