- IBY687PO ;AITC/VD - Post-Installation for IB patch 687; OCT 02, 2020
- ;;2.0;INTEGRATED BILLING;**687**;MAR 21,1994;Build 88
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; ICR #1367 for the usage of ^XPDKEY.
- ; ICR #10141 for the usage of ^XPDUTL.
- ; ICR #4677 for the usage of CREATE^XUSAP.
- ; ICR #10007 for the usage of DO^DIC1.
- ; ICR #2052 for the usage of FIELD^DID.
- ; ICR #2916 for the usage of FILESEC^DDMOD.
- Q
- ;
- POST ; POST-INSTALL
- N IBXPD,PRODENV,SITE,SITENAME,SITENUM,XPDIDTOT
- S XPDIDTOT=13
- S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
- ;
- S PRODENV=$$PROD^XUPROD(1) ; 1=Production Environment, 0=Test Environment
- D MES^XPDUTL("")
- ;
- D IIU(1) ; Add new payer application to PAYER APPLICATION file (#365.13)
- ;
- D SITEFIL(2) ; Set initial value for the IIU MASTER SWITCH field (#350.9,53.01)
- D SITEFIL(3) ; Set initial value for the IIU ENABLED field (#350.9,53.02)
- D SITEFIL(4) ; Set initial value for the IIU RECENT VISIT DAYS field (#350.9,53.03)
- D SITEFIL(5) ; Set initial value for the IIU MIN DAYS BEFORE SHARING field (#350.9,53.04)
- D SITEFIL(6) ; Set initial value for the IIU PURGE SENT RECORDS field (#350.9,53.05)
- D SITEFIL(7) ; Set initial value for the IIU PURGE CANDIDATE RECORDS field (#350.9,53.06)
- D SITEFIL(8) ; Set initial value for the IIU PURGE RECEIVED RECORDS field (#350.9,53.07)
- ;
- D RENAMKY(9) ; Rename the IBCNE EIV MAINTENANCE security key to IBCNE EIV IIU MAINTENANCE
- ;
- D ADDPROXY(10) ; Create "INTERFACE,IB IIU" in file New Person (#200)
- ;
- D CLNIB668(11) ; Clean up Files & Fields that should have been deleted during IB*668 pre-install
- ;
- D FILESEC(12) ;Set Security on INTERFACILITY INSURANCE UPDATE (#365.19) File
- ;
- D SITEREG(13,SITENUM) ; Send site registration message to FSC
- ;
- D MES^XPDUTL("") ; Displays the 'Done' message and finishes the progress bar
- D MES^XPDUTL("POST-Install for IB*2.0*687 Completed.")
- Q
- ;============================
- IIU(IBXPD) ; Add new payer application to PAYER APPLICATION file (#365.13)
- N IBERR,IBIEN,DATA
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- D MES^XPDUTL("Adding ""IIU"" as a new Payer Application in PAYER APPLICATION file (#365.13)")
- ;
- S DATA(.01)="IIU"
- ;
- I $$FIND1^DIC(365.13,,,"IIU") D G IIUQ ; IIU already exists in file.
- . D MES^XPDUTL("IIU already exists in the Payer Application file (#355.13).")
- ;
- S IBIEN=$$ADD^IBDFDBS(365.13,,.DATA,.IBERR)
- ;
- I IBERR D G IIUQ
- . D BMES^XPDUTL("")
- . D BMES^XPDUTL("*** ERROR ADDING ""IIU"" TO THE PAYER APPLICATION FILE (#365.13) - Log a Service Ticket! ***")
- ;
- D MES^XPDUTL("Payer Application: IIU added successfully")
- ;
- IIUQ ;
- Q
- ;
- SITEFIL(IBXPD) ; Set initial value of the new IB Site Parameter fields (US23559)
- N DA,DIE,DR
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- ;
- I IBXPD=2 D Q
- . D MES^XPDUTL("Initialize value of IIU MASTER SWITCH field to NULL in IB SITE PARAMETERS file...")
- . I $$GET1^DIQ(350.9,"1,",53.01)'="" D Q ; Skip if this field is already set.
- . . D BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- . . D MES^XPDUTL(" ...Skipping the initialization of the IIU MASTER SWITCH field.") Q
- . S DA=1,DIE=350.9,DR="53.01///" D ^DIE ; Set to NULL because FSC controls this setting.
- . K DA,DIE,DR
- ;
- I IBXPD=3 D Q
- . D MES^XPDUTL("Initialize value of IIU ENABLED to YES in IB SITE PARAMETERS file...")
- . I $$GET1^DIQ(350.9,"1,",53.02)'="" D Q ; Skip if this field is already set.
- . . D BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- . . D MES^XPDUTL(" ...Skipping the initialization of the IIU ENABLED field.") Q
- . S DIE=350.9,DA=1,DR="53.02///"_"Y" D ^DIE
- . K DA,DIE,DR
- ;
- I IBXPD=4 D Q
- . D MES^XPDUTL("Initialize value of IIU RECENT VISIT DAYS field to 335 in IB SITE PARAMETERS file...")
- . I $$GET1^DIQ(350.9,"1,",53.03)'="" D Q ; Skip if this field is already set.
- . . D BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- . . D MES^XPDUTL(" ...Skipping the initialization of the IIU RECENT VISIT DAYS field.") Q
- . S DA=1,DIE=350.9,DR="53.03///335" D ^DIE
- . K DA,DIE,DR
- ;
- I IBXPD=5 D Q
- . D MES^XPDUTL("Initialize value of IIU MIN DAYS BEFORE SHARING field to 170 in IB SITE PARAMETERS file...")
- . I $$GET1^DIQ(350.9,"1,",53.04)'="" D Q ; Skip if this field is already set.
- . . D BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- . . D MES^XPDUTL(" ...Skipping the initialization of the IIU MIN DAYS BEFORE SHARING field.") Q
- . S DA=1,DIE=350.9,DR="53.04///170" D ^DIE
- . K DA,DIE,DR
- ;
- I IBXPD=6 D Q
- . D MES^XPDUTL("Initialize value of IIU PURGE SENT RECORDS field to 180 in IB SITE PARAMETERS file...")
- . I $$GET1^DIQ(350.9,"1,",53.05)'="" D Q ; Skip if this field is already set.
- . . D BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- . . D MES^XPDUTL(" ...Skipping the initialization of the IIU PURGE SENT RECORDS field.") Q
- . S DA=1,DIE=350.9,DR="53.05///180" D ^DIE
- . K DA,DIE,DR
- ;
- I IBXPD=7 D Q
- . D MES^XPDUTL("Initialize value of IIU PURGE CANDIDATE RECORDS field to 7 in IB SITE PARAMETERS file...")
- . I $$GET1^DIQ(350.9,"1,",53.06)'="" D Q ; Skip if this field is already set.
- . . D BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- . . D MES^XPDUTL(" ...Skipping the initialization of the IIU PURGE CANDIDATE RECORDS field.") Q
- . S DA=1,DIE=350.9,DR="53.06///7" D ^DIE
- . K DA,DIE,DR
- ;
- I IBXPD=8 D Q
- . D MES^XPDUTL("Initialize value of IIU PURGE RECEIVED RECORDS field to 30 in IB SITE PARAMETERS file...")
- . I $$GET1^DIQ(350.9,"1,",53.07)'="" D Q ; Skip if this field is already set.
- . . D BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- . . D MES^XPDUTL(" ...Skipping the initialization of the IIU PURGE RECEIVED RECORDS field.") Q
- . S DA=1,DIE=350.9,DR="53.07///30" D ^DIE
- . K DA,DIE,DR
- Q
- ;
- RENAMKY(IBXPD) ; Rename the IBCNE EIV MAINTENANCE security key to IBCNE EIV IIU MAINTENANCE
- N IBFLAG
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- D MES^XPDUTL("Renaming the IBCNE EIV MAINTENANCE security key...")
- ;
- ; Check whether the security key has already been renamed.
- I $O(^DIC(19.1,"B","IBCNE EIV MAINTENANCE",0))'>0,+$O(^DIC(19.1,"B","IBCNE EIV IIU MAINTENANCE",0)) D Q
- . D MES^XPDUTL("The IBCNE EIV MAINTENANCE security key was previously renamed")
- . D MES^XPDUTL("to IBCNE EIV IIU MAINTENANCE. No change made.")
- ;
- ; Rename the security key.
- S IBFLAG=$$RENAME^XPDKEY("IBCNE EIV MAINTENANCE","IBCNE EIV IIU MAINTENANCE") ; ICR # 1367
- I 'IBFLAG D MES^XPDUTL("The IBCNE EIV MAINTENANCE security key was not renamed!"),MES^XPDUTL("Aborting security key update.") Q
- ;
- D MES^XPDUTL("The IBCNE EIV MAINTENANCE security key has been successfully renamed")
- D MES^XPDUTL("to IBCNE EIV IIU MAINTENANCE!")
- Q
- ;
- ADDPROXY(IBXPD) ;Add APPLICATION PROXY user to file 200. Supported by IA#4677.
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- D MES^XPDUTL("Adding entry 'INTERFACE,IB IIU' to the New Person file (#200)")
- N IEN200
- S IEN200=$$CREATE^XUSAP("INTERFACE,IB IIU","")
- I +IEN200=0 D MES^XPDUTL("........'INTERFACE,IB IIU' already exists.")
- I +IEN200>0 D MES^XPDUTL("........'INTERFACE,IB IIU' added.")
- I IEN200<0 D MES^XPDUTL("........ERROR: 'INTERFACE,IB IIU' NOT added.")
- Q
- ;
- CLNIB668(IBXPD) ;Clean up Files & Fields that weren't deleted during the IB*668 pre-install.
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- D DELFILES ; delete files
- D DFLDS ; delete fields
- Q
- ;
- DELFILES ; Delete files and sub-files.
- D BMES^XPDUTL("Checking for SSVI Related Files and Sub-files for possible deletion.")
- ;
- N DIC,DO,FILE,FOUND,SUBFILE
- ; According to the Developer Guide, you can use a file # or global root to delete the file
- ; This module of code will delete the following Files and their related Sub-files:
- S FOUND=0
- ;
- ; IB SSVI PIN/HL7 PIVOT File #366 and it's related sub-files #366.04 and #366.05
- S FILE=366
- S DIC="^IBCN(366," D DO^DIC1 ; ICR # 10007
- I $P(DO,"^")="IB SSVI PIN/HL7 PIVOT" D DFILE(FILE)
- K DIC,DO
- ;
- ;IB INSURANCE INCONSISTENT DATA File #366.1 and it's related sub-file #366.16
- S FILE=366.1
- S DIC="^IBCN(366.1," D DO^DIC1
- I $P(DO,"^")="IB INSURANCE INCONSISTENT DATA" D DFILE(FILE)
- K DIC,DO
- ;
- ;IB INSURANCE CONSISTENCY ELEMENTS File #366.2 and it's related sub-file #366.21
- S FILE=366.2
- S DIC="^IBCN(366.2," D DO^DIC1
- I $P(DO,"^")="IB INSURANCE CONSISTENCY ELEMENTS" D DFILE(FILE)
- ;I $P(DO,"^")="IB INSURANCE INCONSISTENCY ELEMENTS" D DFILE(FILE)
- K DIC,DO
- ;
- I FOUND D BMES^XPDUTL("SSVI Related Files and Sub-files Deleted.")
- I 'FOUND D BMES^XPDUTL("No SSVI Related Files and Sub-files were deleted.")
- Q
- ;
- DFILE(FILE) ;Delete a File
- N DIU
- S FOUND=1
- S DIU=FILE,DIU(0)="D" ; "D"elete the data dictionary along with it's data.
- D EN^DIU2
- K DIU
- D BMES^XPDUTL(" ....Deleted File #"_FILE_" it's data and related sub-files")
- Q
- ;
- DFLDS ; Delete fields and data when needed.
- D BMES^XPDUTL("Checking for IB Site Parameter File (#350.9) SSVI Fields for possible deletion.")
- ;
- N DA,DIC,DIK,DO,FLD,FLD100,FLD101,FLD102,FLD103,FLDNO,FOUND
- ; This module of code deletes the data and the definitions
- ; for the following fields in the IB SITE PARAMETERS File (#350.9):
- ; - Field # 100 IB SSVI DISABLE/ENABLE
- ; - Field # 101 IB SSVI LAST INS DATE XFER
- ; - Field # 102 IB CURRENT PIVOT ENTRY HL7
- ; - Field # 103 IB PIVOT FILE DAYS TO RETAIN
- ;
- ; Delete the data.
- S (FLD100,FLD101,FLD102,FLD103,FOUND)=0
- ;
- S DA=0 F S DA=$O(^IBE(350.9,DA)) Q:'DA D
- . N DIE,DR,FNAME
- . F FLDNO=100,101,102,103 D
- . . D FIELD^DID(350.9,FLDNO,,"LABEL","FNAME") ;ICR # 2052
- . . S FLD="FLD"_FLDNO
- . . I FLDNO=100 I $G(FNAME("LABEL"))="IB SSVI DISABLE/ENABLE" S @FLD=1
- . . I FLDNO=101 I $G(FNAME("LABEL"))="IB SSVI LAST INS DATE XFER" S @FLD=1
- . . ;I FLDNO=102 I $G(FNAME("LABEL"))="IB CURRENT PIVOT ENTRY HL7" S @FLD=1
- . . I FLDNO=102 I $G(FNAME("LABEL"))="IB CURRENT PIVOT ENTRY" S @FLD=1
- . . I FLDNO=103 I $G(FNAME("LABEL"))="IB PIVOT FILE DAYS TO RETAIN" S @FLD=1
- . . K FNAME
- . . I @FLD=1 D
- . . . S FOUND=1
- . . . S DR=FLDNO_"////@",DIE="^IBE(350.9," D ^DIE
- . . . D BMES^XPDUTL(" ....Deleted Data for Field (#350.9,"_FLDNO_").")
- ;
- ; Delete the field definitions.
- F FLDNO=100,101,102,103 D
- . S FLD="FLD"_FLDNO
- . I @FLD=1 D
- . . K DA
- . . S DIK="^DD(350.9,",DA=FLDNO,DA(1)=350.9 D ^DIK
- . . D BMES^XPDUTL(" .......Deleted Definition for Field (#350.9,"_FLDNO_").")
- ;
- I FOUND D BMES^XPDUTL("IB Site Parameter File (#350.9) SSVI Fields Deleted.")
- I 'FOUND D BMES^XPDUTL("No IB Site Parameter File (#350.9) SSVI Fields were deleted.")
- Q
- ;
- FILESEC(IBXPD) ;Update File Security on INTERFACILITY INSURANCE UPDATE file (#365.19)
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- D MES^XPDUTL("Updating file security on the INTERFACILITY INSURANCE UPDATE (#365.19) file ... ")
- N CODES,ERROR
- ;
- S CODES("AUDIT")="@"
- S CODES("DD")="@"
- S CODES("DEL")="@"
- S CODES("LAYGO")="@"
- S CODES("WR")="@"
- ;
- D FILESEC^DDMOD(365.19,.CODES,"ERROR")
- ;
- I $D(ERROR) D MES^XPDUTL("File security was NOT updated.") G FILESECQ
- ;
- D MES^XPDUTL("File security has been updated.")
- FILESECQ ;
- Q
- ;
- SITEREG(IBXPD,SITENUM) ; send site registration message to FSC
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- D MES^XPDUTL("Send eIV site registration message to FSC ... ")
- ;
- I '$$PROD^XUPROD(1) D MES^XPDUTL("N/A - Not a production account - No site registration message sent") G SITEREGQ
- I SITENUM=358 D MES^XPDUTL("Current Site is MANILA - NO eIV site registration message sent") G SITEREGQ
- D ^IBCNEHLM
- D MES^XPDUTL("eIV site registration message was successfully sent")
- ;
- SITEREGQ ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY687PO 12224 printed Feb 19, 2025@00:01:31 Page 2
- IBY687PO ;AITC/VD - Post-Installation for IB patch 687; OCT 02, 2020
- +1 ;;2.0;INTEGRATED BILLING;**687**;MAR 21,1994;Build 88
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; ICR #1367 for the usage of ^XPDKEY.
- +5 ; ICR #10141 for the usage of ^XPDUTL.
- +6 ; ICR #4677 for the usage of CREATE^XUSAP.
- +7 ; ICR #10007 for the usage of DO^DIC1.
- +8 ; ICR #2052 for the usage of FIELD^DID.
- +9 ; ICR #2916 for the usage of FILESEC^DDMOD.
- +10 QUIT
- +11 ;
- POST ; POST-INSTALL
- +1 NEW IBXPD,PRODENV,SITE,SITENAME,SITENUM,XPDIDTOT
- +2 SET XPDIDTOT=13
- +3 SET SITE=$$SITE^VASITE
- SET SITENAME=$PIECE(SITE,U,2)
- SET SITENUM=$PIECE(SITE,U,3)
- +4 ;
- +5 ; 1=Production Environment, 0=Test Environment
- SET PRODENV=$$PROD^XUPROD(1)
- +6 DO MES^XPDUTL("")
- +7 ;
- +8 ; Add new payer application to PAYER APPLICATION file (#365.13)
- DO IIU(1)
- +9 ;
- +10 ; Set initial value for the IIU MASTER SWITCH field (#350.9,53.01)
- DO SITEFIL(2)
- +11 ; Set initial value for the IIU ENABLED field (#350.9,53.02)
- DO SITEFIL(3)
- +12 ; Set initial value for the IIU RECENT VISIT DAYS field (#350.9,53.03)
- DO SITEFIL(4)
- +13 ; Set initial value for the IIU MIN DAYS BEFORE SHARING field (#350.9,53.04)
- DO SITEFIL(5)
- +14 ; Set initial value for the IIU PURGE SENT RECORDS field (#350.9,53.05)
- DO SITEFIL(6)
- +15 ; Set initial value for the IIU PURGE CANDIDATE RECORDS field (#350.9,53.06)
- DO SITEFIL(7)
- +16 ; Set initial value for the IIU PURGE RECEIVED RECORDS field (#350.9,53.07)
- DO SITEFIL(8)
- +17 ;
- +18 ; Rename the IBCNE EIV MAINTENANCE security key to IBCNE EIV IIU MAINTENANCE
- DO RENAMKY(9)
- +19 ;
- +20 ; Create "INTERFACE,IB IIU" in file New Person (#200)
- DO ADDPROXY(10)
- +21 ;
- +22 ; Clean up Files & Fields that should have been deleted during IB*668 pre-install
- DO CLNIB668(11)
- +23 ;
- +24 ;Set Security on INTERFACILITY INSURANCE UPDATE (#365.19) File
- DO FILESEC(12)
- +25 ;
- +26 ; Send site registration message to FSC
- DO SITEREG(13,SITENUM)
- +27 ;
- +28 ; Displays the 'Done' message and finishes the progress bar
- DO MES^XPDUTL("")
- +29 DO MES^XPDUTL("POST-Install for IB*2.0*687 Completed.")
- +30 QUIT
- +31 ;============================
- IIU(IBXPD) ; Add new payer application to PAYER APPLICATION file (#365.13)
- +1 NEW IBERR,IBIEN,DATA
- +2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- +3 DO MES^XPDUTL("-------------")
- +4 DO MES^XPDUTL("Adding ""IIU"" as a new Payer Application in PAYER APPLICATION file (#365.13)")
- +5 ;
- +6 SET DATA(.01)="IIU"
- +7 ;
- +8 ; IIU already exists in file.
- IF $$FIND1^DIC(365.13,,,"IIU")
- Begin DoDot:1
- +9 DO MES^XPDUTL("IIU already exists in the Payer Application file (#355.13).")
- End DoDot:1
- GOTO IIUQ
- +10 ;
- +11 SET IBIEN=$$ADD^IBDFDBS(365.13,,.DATA,.IBERR)
- +12 ;
- +13 IF IBERR
- Begin DoDot:1
- +14 DO BMES^XPDUTL("")
- +15 DO BMES^XPDUTL("*** ERROR ADDING ""IIU"" TO THE PAYER APPLICATION FILE (#365.13) - Log a Service Ticket! ***")
- End DoDot:1
- GOTO IIUQ
- +16 ;
- +17 DO MES^XPDUTL("Payer Application: IIU added successfully")
- +18 ;
- IIUQ ;
- +1 QUIT
- +2 ;
- SITEFIL(IBXPD) ; Set initial value of the new IB Site Parameter fields (US23559)
- +1 NEW DA,DIE,DR
- +2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- +3 DO MES^XPDUTL("-------------")
- +4 ;
- +5 IF IBXPD=2
- Begin DoDot:1
- +6 DO MES^XPDUTL("Initialize value of IIU MASTER SWITCH field to NULL in IB SITE PARAMETERS file...")
- +7 ; Skip if this field is already set.
- IF $$GET1^DIQ(350.9,"1,",53.01)'=""
- Begin DoDot:2
- +8 DO BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- +9 DO MES^XPDUTL(" ...Skipping the initialization of the IIU MASTER SWITCH field.")
- QUIT
- End DoDot:2
- QUIT
- +10 ; Set to NULL because FSC controls this setting.
- SET DA=1
- SET DIE=350.9
- SET DR="53.01///"
- DO ^DIE
- +11 KILL DA,DIE,DR
- End DoDot:1
- QUIT
- +12 ;
- +13 IF IBXPD=3
- Begin DoDot:1
- +14 DO MES^XPDUTL("Initialize value of IIU ENABLED to YES in IB SITE PARAMETERS file...")
- +15 ; Skip if this field is already set.
- IF $$GET1^DIQ(350.9,"1,",53.02)'=""
- Begin DoDot:2
- +16 DO BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- +17 DO MES^XPDUTL(" ...Skipping the initialization of the IIU ENABLED field.")
- QUIT
- End DoDot:2
- QUIT
- +18 SET DIE=350.9
- SET DA=1
- SET DR="53.02///"_"Y"
- DO ^DIE
- +19 KILL DA,DIE,DR
- End DoDot:1
- QUIT
- +20 ;
- +21 IF IBXPD=4
- Begin DoDot:1
- +22 DO MES^XPDUTL("Initialize value of IIU RECENT VISIT DAYS field to 335 in IB SITE PARAMETERS file...")
- +23 ; Skip if this field is already set.
- IF $$GET1^DIQ(350.9,"1,",53.03)'=""
- Begin DoDot:2
- +24 DO BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- +25 DO MES^XPDUTL(" ...Skipping the initialization of the IIU RECENT VISIT DAYS field.")
- QUIT
- End DoDot:2
- QUIT
- +26 SET DA=1
- SET DIE=350.9
- SET DR="53.03///335"
- DO ^DIE
- +27 KILL DA,DIE,DR
- End DoDot:1
- QUIT
- +28 ;
- +29 IF IBXPD=5
- Begin DoDot:1
- +30 DO MES^XPDUTL("Initialize value of IIU MIN DAYS BEFORE SHARING field to 170 in IB SITE PARAMETERS file...")
- +31 ; Skip if this field is already set.
- IF $$GET1^DIQ(350.9,"1,",53.04)'=""
- Begin DoDot:2
- +32 DO BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- +33 DO MES^XPDUTL(" ...Skipping the initialization of the IIU MIN DAYS BEFORE SHARING field.")
- QUIT
- End DoDot:2
- QUIT
- +34 SET DA=1
- SET DIE=350.9
- SET DR="53.04///170"
- DO ^DIE
- +35 KILL DA,DIE,DR
- End DoDot:1
- QUIT
- +36 ;
- +37 IF IBXPD=6
- Begin DoDot:1
- +38 DO MES^XPDUTL("Initialize value of IIU PURGE SENT RECORDS field to 180 in IB SITE PARAMETERS file...")
- +39 ; Skip if this field is already set.
- IF $$GET1^DIQ(350.9,"1,",53.05)'=""
- Begin DoDot:2
- +40 DO BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- +41 DO MES^XPDUTL(" ...Skipping the initialization of the IIU PURGE SENT RECORDS field.")
- QUIT
- End DoDot:2
- QUIT
- +42 SET DA=1
- SET DIE=350.9
- SET DR="53.05///180"
- DO ^DIE
- +43 KILL DA,DIE,DR
- End DoDot:1
- QUIT
- +44 ;
- +45 IF IBXPD=7
- Begin DoDot:1
- +46 DO MES^XPDUTL("Initialize value of IIU PURGE CANDIDATE RECORDS field to 7 in IB SITE PARAMETERS file...")
- +47 ; Skip if this field is already set.
- IF $$GET1^DIQ(350.9,"1,",53.06)'=""
- Begin DoDot:2
- +48 DO BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- +49 DO MES^XPDUTL(" ...Skipping the initialization of the IIU PURGE CANDIDATE RECORDS field.")
- QUIT
- End DoDot:2
- QUIT
- +50 SET DA=1
- SET DIE=350.9
- SET DR="53.06///7"
- DO ^DIE
- +51 KILL DA,DIE,DR
- End DoDot:1
- QUIT
- +52 ;
- +53 IF IBXPD=8
- Begin DoDot:1
- +54 DO MES^XPDUTL("Initialize value of IIU PURGE RECEIVED RECORDS field to 30 in IB SITE PARAMETERS file...")
- +55 ; Skip if this field is already set.
- IF $$GET1^DIQ(350.9,"1,",53.07)'=""
- Begin DoDot:2
- +56 DO BMES^XPDUTL(" Patch IB*2.0*687 has been previously installed...")
- +57 DO MES^XPDUTL(" ...Skipping the initialization of the IIU PURGE RECEIVED RECORDS field.")
- QUIT
- End DoDot:2
- QUIT
- +58 SET DA=1
- SET DIE=350.9
- SET DR="53.07///30"
- DO ^DIE
- +59 KILL DA,DIE,DR
- End DoDot:1
- QUIT
- +60 QUIT
- +61 ;
- RENAMKY(IBXPD) ; Rename the IBCNE EIV MAINTENANCE security key to IBCNE EIV IIU MAINTENANCE
- +1 NEW IBFLAG
- +2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- +3 DO MES^XPDUTL("-------------")
- +4 DO MES^XPDUTL("Renaming the IBCNE EIV MAINTENANCE security key...")
- +5 ;
- +6 ; Check whether the security key has already been renamed.
- +7 IF $ORDER(^DIC(19.1,"B","IBCNE EIV MAINTENANCE",0))'>0
- IF +$ORDER(^DIC(19.1,"B","IBCNE EIV IIU MAINTENANCE",0))
- Begin DoDot:1
- +8 DO MES^XPDUTL("The IBCNE EIV MAINTENANCE security key was previously renamed")
- +9 DO MES^XPDUTL("to IBCNE EIV IIU MAINTENANCE. No change made.")
- End DoDot:1
- QUIT
- +10 ;
- +11 ; Rename the security key.
- +12 ; ICR # 1367
- SET IBFLAG=$$RENAME^XPDKEY("IBCNE EIV MAINTENANCE","IBCNE EIV IIU MAINTENANCE")
- +13 IF 'IBFLAG
- DO MES^XPDUTL("The IBCNE EIV MAINTENANCE security key was not renamed!")
- DO MES^XPDUTL("Aborting security key update.")
- QUIT
- +14 ;
- +15 DO MES^XPDUTL("The IBCNE EIV MAINTENANCE security key has been successfully renamed")
- +16 DO MES^XPDUTL("to IBCNE EIV IIU MAINTENANCE!")
- +17 QUIT
- +18 ;
- ADDPROXY(IBXPD) ;Add APPLICATION PROXY user to file 200. Supported by IA#4677.
- +1 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- +2 DO MES^XPDUTL("-------------")
- +3 DO MES^XPDUTL("Adding entry 'INTERFACE,IB IIU' to the New Person file (#200)")
- +4 NEW IEN200
- +5 SET IEN200=$$CREATE^XUSAP("INTERFACE,IB IIU","")
- +6 IF +IEN200=0
- DO MES^XPDUTL("........'INTERFACE,IB IIU' already exists.")
- +7 IF +IEN200>0
- DO MES^XPDUTL("........'INTERFACE,IB IIU' added.")
- +8 IF IEN200<0
- DO MES^XPDUTL("........ERROR: 'INTERFACE,IB IIU' NOT added.")
- +9 QUIT
- +10 ;
- CLNIB668(IBXPD) ;Clean up Files & Fields that weren't deleted during the IB*668 pre-install.
- +1 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- +2 DO MES^XPDUTL("-------------")
- +3 ; delete files
- DO DELFILES
- +4 ; delete fields
- DO DFLDS
- +5 QUIT
- +6 ;
- DELFILES ; Delete files and sub-files.
- +1 DO BMES^XPDUTL("Checking for SSVI Related Files and Sub-files for possible deletion.")
- +2 ;
- +3 NEW DIC,DO,FILE,FOUND,SUBFILE
- +4 ; According to the Developer Guide, you can use a file # or global root to delete the file
- +5 ; This module of code will delete the following Files and their related Sub-files:
- +6 SET FOUND=0
- +7 ;
- +8 ; IB SSVI PIN/HL7 PIVOT File #366 and it's related sub-files #366.04 and #366.05
- +9 SET FILE=366
- +10 ; ICR # 10007
- SET DIC="^IBCN(366,"
- DO DO^DIC1
- +11 IF $PIECE(DO,"^")="IB SSVI PIN/HL7 PIVOT"
- DO DFILE(FILE)
- +12 KILL DIC,DO
- +13 ;
- +14 ;IB INSURANCE INCONSISTENT DATA File #366.1 and it's related sub-file #366.16
- +15 SET FILE=366.1
- +16 SET DIC="^IBCN(366.1,"
- DO DO^DIC1
- +17 IF $PIECE(DO,"^")="IB INSURANCE INCONSISTENT DATA"
- DO DFILE(FILE)
- +18 KILL DIC,DO
- +19 ;
- +20 ;IB INSURANCE CONSISTENCY ELEMENTS File #366.2 and it's related sub-file #366.21
- +21 SET FILE=366.2
- +22 SET DIC="^IBCN(366.2,"
- DO DO^DIC1
- +23 IF $PIECE(DO,"^")="IB INSURANCE CONSISTENCY ELEMENTS"
- DO DFILE(FILE)
- +24 ;I $P(DO,"^")="IB INSURANCE INCONSISTENCY ELEMENTS" D DFILE(FILE)
- +25 KILL DIC,DO
- +26 ;
- +27 IF FOUND
- DO BMES^XPDUTL("SSVI Related Files and Sub-files Deleted.")
- +28 IF 'FOUND
- DO BMES^XPDUTL("No SSVI Related Files and Sub-files were deleted.")
- +29 QUIT
- +30 ;
- DFILE(FILE) ;Delete a File
- +1 NEW DIU
- +2 SET FOUND=1
- +3 ; "D"elete the data dictionary along with it's data.
- SET DIU=FILE
- SET DIU(0)="D"
- +4 DO EN^DIU2
- +5 KILL DIU
- +6 DO BMES^XPDUTL(" ....Deleted File #"_FILE_" it's data and related sub-files")
- +7 QUIT
- +8 ;
- DFLDS ; Delete fields and data when needed.
- +1 DO BMES^XPDUTL("Checking for IB Site Parameter File (#350.9) SSVI Fields for possible deletion.")
- +2 ;
- +3 NEW DA,DIC,DIK,DO,FLD,FLD100,FLD101,FLD102,FLD103,FLDNO,FOUND
- +4 ; This module of code deletes the data and the definitions
- +5 ; for the following fields in the IB SITE PARAMETERS File (#350.9):
- +6 ; - Field # 100 IB SSVI DISABLE/ENABLE
- +7 ; - Field # 101 IB SSVI LAST INS DATE XFER
- +8 ; - Field # 102 IB CURRENT PIVOT ENTRY HL7
- +9 ; - Field # 103 IB PIVOT FILE DAYS TO RETAIN
- +10 ;
- +11 ; Delete the data.
- +12 SET (FLD100,FLD101,FLD102,FLD103,FOUND)=0
- +13 ;
- +14 SET DA=0
- FOR
- SET DA=$ORDER(^IBE(350.9,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +15 NEW DIE,DR,FNAME
- +16 FOR FLDNO=100,101,102,103
- Begin DoDot:2
- +17 ;ICR # 2052
- DO FIELD^DID(350.9,FLDNO,,"LABEL","FNAME")
- +18 SET FLD="FLD"_FLDNO
- +19 IF FLDNO=100
- IF $GET(FNAME("LABEL"))="IB SSVI DISABLE/ENABLE"
- SET @FLD=1
- +20 IF FLDNO=101
- IF $GET(FNAME("LABEL"))="IB SSVI LAST INS DATE XFER"
- SET @FLD=1
- +21 ;I FLDNO=102 I $G(FNAME("LABEL"))="IB CURRENT PIVOT ENTRY HL7" S @FLD=1
- +22 IF FLDNO=102
- IF $GET(FNAME("LABEL"))="IB CURRENT PIVOT ENTRY"
- SET @FLD=1
- +23 IF FLDNO=103
- IF $GET(FNAME("LABEL"))="IB PIVOT FILE DAYS TO RETAIN"
- SET @FLD=1
- +24 KILL FNAME
- +25 IF @FLD=1
- Begin DoDot:3
- +26 SET FOUND=1
- +27 SET DR=FLDNO_"////@"
- SET DIE="^IBE(350.9,"
- DO ^DIE
- +28 DO BMES^XPDUTL(" ....Deleted Data for Field (#350.9,"_FLDNO_").")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +29 ;
- +30 ; Delete the field definitions.
- +31 FOR FLDNO=100,101,102,103
- Begin DoDot:1
- +32 SET FLD="FLD"_FLDNO
- +33 IF @FLD=1
- Begin DoDot:2
- +34 KILL DA
- +35 SET DIK="^DD(350.9,"
- SET DA=FLDNO
- SET DA(1)=350.9
- DO ^DIK
- +36 DO BMES^XPDUTL(" .......Deleted Definition for Field (#350.9,"_FLDNO_").")
- End DoDot:2
- End DoDot:1
- +37 ;
- +38 IF FOUND
- DO BMES^XPDUTL("IB Site Parameter File (#350.9) SSVI Fields Deleted.")
- +39 IF 'FOUND
- DO BMES^XPDUTL("No IB Site Parameter File (#350.9) SSVI Fields were deleted.")
- +40 QUIT
- +41 ;
- FILESEC(IBXPD) ;Update File Security on INTERFACILITY INSURANCE UPDATE file (#365.19)
- +1 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- +2 DO MES^XPDUTL("-------------")
- +3 DO MES^XPDUTL("Updating file security on the INTERFACILITY INSURANCE UPDATE (#365.19) file ... ")
- +4 NEW CODES,ERROR
- +5 ;
- +6 SET CODES("AUDIT")="@"
- +7 SET CODES("DD")="@"
- +8 SET CODES("DEL")="@"
- +9 SET CODES("LAYGO")="@"
- +10 SET CODES("WR")="@"
- +11 ;
- +12 DO FILESEC^DDMOD(365.19,.CODES,"ERROR")
- +13 ;
- +14 IF $DATA(ERROR)
- DO MES^XPDUTL("File security was NOT updated.")
- GOTO FILESECQ
- +15 ;
- +16 DO MES^XPDUTL("File security has been updated.")
- FILESECQ ;
- +1 QUIT
- +2 ;
- SITEREG(IBXPD,SITENUM) ; send site registration message to FSC
- +1 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- +2 DO MES^XPDUTL("-------------")
- +3 DO MES^XPDUTL("Send eIV site registration message to FSC ... ")
- +4 ;
- +5 IF '$$PROD^XUPROD(1)
- DO MES^XPDUTL("N/A - Not a production account - No site registration message sent")
- GOTO SITEREGQ
- +6 IF SITENUM=358
- DO MES^XPDUTL("Current Site is MANILA - NO eIV site registration message sent")
- GOTO SITEREGQ
- +7 DO ^IBCNEHLM
- +8 DO MES^XPDUTL("eIV site registration message was successfully sent")
- +9 ;
- SITEREGQ ;
- +1 QUIT