Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY668PR

IBY668PR.m

Go to the documentation of this file. 
  1. IBY668PR ;AITC/VD - PRE-Installation for IB patch 668; JUL 9, 2020
  1.  ;;2.0;INTEGRATED BILLING;**668**;MAR 21,1994;Build 28
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; ICR #10013 for the usage of ^DIK.
  1.  ; ICR #10014 for the usage of EN^DIU2
  1.  ; ICR #10141 for the usage of ^XPDUTL.
  1.  Q
  1.  ;
  1. PREINS ; preinstall tag
  1.  ;
  1.  N INSTALLED,XPDIDTOT
  1.  S INSTALLED=$$PATCH^XPDUTL("IB*2.0*668")
  1.  S XPDIDTOT=2
  1.  ;
  1.  D BMES^XPDUTL("    IB*2.0*668 Pre-Install starts .....")
  1.  ;
  1.  D DELFILES(1)
  1.  ;
  1.  D DFLDS(2)  ; delete fields
  1.  ;
  1.  D BMES^XPDUTL("    IB*2.0*668 Pre-Install is complete.")
  1.  Q
  1.  ;
  1. DELFILES(IBXPD) ; Delete files and sub-files
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D BMES^XPDUTL("Deleting SSVI Related Files and Sub-files.")
  1.  ;
  1.  ; if the patch was installed previously - skip deleting files and sub-files
  1.  I INSTALLED D  Q
  1.  . D BMES^XPDUTL("    Patch IB*2.0*668 has been previously installed...")
  1.  . D MES^XPDUTL("    ...Skipping the deletion of files & sub-files.") Q
  1.  ;
  1.  N FILE,SUBFILE
  1.  ; According to the Developer Guide, you can use a file # or global root to delete the file
  1.  ; This module of code will delete the following Files and their related Sub-files:
  1.  ; 
  1.  ; IB SSVI PIN/HL7 PIVOT File #366 and it's related sub-files #366.04 and #366.05
  1.  S FILE=366
  1.  D DFILE(FILE)
  1.  ;
  1.  ;IB INSURANCE INCONSISTENT DATA File #366.1 and it's related sub-file #366.16
  1.  S FILE=366.1
  1.  D DFILE(FILE)
  1.  ;
  1.  ;IB INSURANCE INCONSISTENCY ELEMENTS File #366.2 and it's related sub-file #366.21
  1.  S FILE=366.2
  1.  D DFILE(FILE)
  1.  ;
  1.  D BMES^XPDUTL("SSVI Related Files and Sub-files Deleted.")
  1.  Q
  1.  ;
  1. DFILE(FILE)   ;Delete a File
  1.  N DIU
  1.  S DIU=FILE,DIU(0)="D"  ; "D"elete the data dictionary along with it's data.
  1.  D EN^DIU2
  1.  K DIU
  1.  D BMES^XPDUTL("    ....Deleted File #"_FILE_" it's data and related sub-files")
  1.  Q
  1.  ;
  1. DFLDS(IBXPD) ; Delete fields and data when needed.
  1.  ;
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D BMES^XPDUTL("Deleting IB Site Parameter File (#350.9) SSVI Fields.")
  1.  ;
  1.  ; if the patch was installed previously - skip deleting files and sub-files
  1.  N DA,DIK,FLDNO
  1.  ; This module of code deletes the data and the definitions
  1.  ; for the following fields in the IB SITE PARAMETERS File (#350.9):
  1.  ;   -  Field # 100 IB SSVI DISABLE/ENABLE
  1.  ;   -  Field # 101 IB SSVI LAST INS DATE XFER
  1.  ;   -  Field # 102 IB CURRENT PIVOT ENTRY
  1.  ;   -  Field # 103 IB PIVOT FILE DAYS TO RETAIN
  1.  ;
  1.  I INSTALLED D  Q
  1.  . D BMES^XPDUTL("    Patch IB*2.0*668 has been previously installed...")
  1.  . D MES^XPDUTL("    ...Skipping the deletion of the IB Site Parameter fields.") Q
  1.  ;
  1.  ; Delete the data.
  1.  S DA=0 F  S DA=$O(^IBE(350.9,DA)) Q:'DA  D
  1.  . N DIE,DR
  1.  . F FLDNO=100,101,102,103 D
  1.  . . S DR=FLDNO_"////@",DIE="^IBE(350.9," D ^DIE
  1.  . . D BMES^XPDUTL("    ....Deleted Data for Field (#350.9,"_FLDNO_").")
  1.  ;
  1.  ; Delete the field definitions.
  1.  F FLDNO=100,101,102,103 D
  1.  . K DA
  1.  . S DIK="^DD(350.9,",DA=FLDNO,DA(1)=350.9 D ^DIK
  1.  . D BMES^XPDUTL("    .......Deleted Definition for Field (#350.9,"_FLDNO_").")
  1.  D BMES^XPDUTL("IB Site Parameter File (#350.9) SSVI Fields Deleted.")
  1.  Q
  1.  ;
  1.  ;========================================================
  1. POST ; Post install routine
  1.  ;
  1.  N IBXPD,PRODENV,SITE,SITENAME,SITENUM,XPDIDTOT
  1.  S XPDIDTOT=4
  1.  S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
  1.  ;
  1.  S PRODENV=$$PROD^XUPROD(1)   ; 1=Production Environment, 0=Test Environment
  1.  D BMES^XPDUTL("    IB*2.0*668 Post-Install starts .....")
  1.  ;
  1.  D IIVTOEIV(1)
  1.  ;
  1.  D CONVERT(2)
  1.  ;
  1.  D STATUPD(3)
  1.  ;
  1.  D ADDSOI(4)
  1.  ;
  1.  D BMES^XPDUTL("    IB*2.0*668 Post-Install is complete.")
  1.  Q
  1.  ;
  1. IIVTOEIV(IBXPD) ; Change Payer Application entry from IIV to EIV
  1.  N DA,DIE,DR
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D BMES^XPDUTL("Changing name of application in the Payer Application file (#365.13)")
  1.  S DIE=365.13,DA=$$FIND1^DIC(365.13,,,"IIV")
  1.  I 'DA D BMES^XPDUTL("    IIV not found in Payer Application File.") Q
  1.  S DR=".01////EIV" D ^DIE
  1.  D BMES^XPDUTL("Name of Payer Application successfully changed from IIV to EIV.")
  1.  Q
  1.  ;
  1. CONVERT(IBXPD) ;
  1.  ;This will file the following data into the new locations in PAYER file (#365.12):
  1.  ; *** For the EIV application only 
  1.  ; #365.121,.11 -> #365.12,.07
  1.  ; #365.121,.12 -> #365.12,.08
  1.  ; #365.121,.07 -> #365.121,4.01
  1.  ; #365.121,.08 -> #365.121,4.02
  1.  ; #365.121,.14 -> #365.121,4.03
  1.  ; #365.121,.15 -> #365.121,4.04
  1.  ;
  1.  N APPIEN,ARRAY,EIVIEN,FDA,IENS,IENS1,MSG,PIEN,SKIPPED,TOTAL
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D BMES^XPDUTL("Copying data to new locations within the PAYER file (#365.12)")
  1.  ;
  1.  S EIVIEN=$$FIND1^DIC(365.13,,"X","EIV","B")
  1.  S (PIEN,SKIPPED,TOTAL)=0
  1.  F  S PIEN=$O(^IBE(365.12,PIEN)) Q:'PIEN  D
  1.  . S APPIEN=0
  1.  . F  S APPIEN=$O(^IBE(365.12,PIEN,1,APPIEN)) Q:'APPIEN  D
  1.  .. K ARRAY
  1.  .. S IENS=APPIEN_","_PIEN_","
  1.  .. D GETS^DIQ(365.121,IENS,".01;.07;.08;.11;.12;.14;.15","I","ARRAY")
  1.  .. I ARRAY(365.121,IENS,.01,"I")'=EIVIEN Q   ; Not the EIV application
  1.  .. S TOTAL=TOTAL+1
  1.  .. S IENS1=PIEN_","
  1.  .. I $$UPDATED(PIEN,IENS,IENS1) S SKIPPED=SKIPPED+1 Q  ;Already updated
  1.  .. S FDA(365.12,IENS1,.07)=ARRAY(365.121,IENS,.11,"I")
  1.  .. S FDA(365.12,IENS1,.08)=ARRAY(365.121,IENS,.12,"I")
  1.  .. S FDA(365.121,IENS,4.01)=ARRAY(365.121,IENS,.07,"I")
  1.  .. S FDA(365.121,IENS,4.02)=ARRAY(365.121,IENS,.08,"I")
  1.  .. S FDA(365.121,IENS,4.03)=ARRAY(365.121,IENS,.14,"I")
  1.  .. S FDA(365.121,IENS,4.04)=ARRAY(365.121,IENS,.15,"I")
  1.  .. D FILE^DIE("","FDA","ERROR")
  1.  I 'SKIPPED S MSG="Data successfully copied to the new locations." G XCONVERT
  1.  I SKIPPED=TOTAL S MSG="Data was previously copied to the new locations, due to a prior install." G XCONVERT
  1.  S MSG=(TOTAL-SKIPPED)_" payers had their data copied. "_SKIPPED_" payers were skipped due to a prior install."
  1. XCONVERT ;
  1.  D BMES^XPDUTL(MSG)
  1.  Q
  1.  ;
  1. UPDATED(PIEN,IENS,IENS1) ; Was this payer record already converted (fields moved)
  1.  N ARRAY1,FOUND
  1.  S FOUND=0
  1.  D GETS^DIQ(365.121,IENS,"4.01;4.02;4.03;4.04","I","ARRAY1")
  1.  I $G(ARRAY1(365.121,IENS,4.01,"I"))'="" S FOUND=1 G UPDTX
  1.  I $G(ARRAY1(365.121,IENS,4.02,"I"))'="" S FOUND=1 G UPDTX
  1.  I $G(ARRAY1(365.121,IENS,4.03,"I"))'="" S FOUND=1 G UPDTX
  1.  I $G(ARRAY1(365.121,IENS,4.04,"I"))'="" S FOUND=1 G UPDTX
  1.  D GETS^DIQ(365.12,IENS1,".07;.08","I","ARRAY1")
  1.  I $G(ARRAY1(365.12,IENS1,.07,"I"))'="" S FOUND=1 G UPDTX
  1.  I $G(ARRAY1(365.12,IENS1,.08,"I"))'="" S FOUND=1 G UPDTX
  1. UPDTX ;
  1.  Q FOUND
  1.  ;
  1. STATUPD(IBXPD) ; Update the DESCRIPTION and CORRECTIVE ACTION fields of IIV STATUS TABLE FILE (#365.15)
  1.  ;
  1.  N FIELD,FILE,IENS,TEXT
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D BMES^XPDUTL("Updating Status description in the IIV STATUS TABLE file (#365.15)")
  1.  ;
  1.  S FILE=365.15
  1.  ;Update DESCRIPTION of status B5
  1.  ;
  1.  S FIELD=1
  1.  S IENS=$$FIND1^DIC(365.15,,,"B5")_","
  1.  S TEXT(1)="eIV could not create an inquiry for this entry.  The payer is not"
  1.  S TEXT(2)="nationally enabled for eIV."
  1.  D WP^DIE(FILE,IENS,FIELD,,"TEXT","ERROR")
  1.  ;
  1.  ;Update DESCRIPTION for status B6
  1.  S IENS=$$FIND1^DIC(365.15,,,"B6")_","
  1.  S TEXT(1)="eIV could not create an inquiry for this entry.  The payer is not locally"
  1.  S TEXT(2)="enabled for eIV."
  1.  D WP^DIE(FILE,IENS,FIELD,,"TEXT","ERROR")
  1.  ;
  1.  ;Update CORRECTIVE ACTION for status B6
  1.  S FIELD=2
  1.  S TEXT(1)="Action to take:  Either use the option ""Payer Edit"" to locally enable this"
  1.  S TEXT(2)="payer or contact the insurance company to manually verify this insurance"
  1.  S TEXT(3)="information."
  1.  D WP^DIE(FILE,IENS,FIELD,,"TEXT","ERROR")
  1.  ;
  1.  D BMES^XPDUTL("Status Description successfully updated.")
  1.  Q
  1.  ;
  1. ADDSOI(IBXPD) ; Add 'ADV MED COST MGMT SOLUTION' to the SOI file.
  1.  N DA,DIK,IBCNT,IBERR,IBIEN,NEWSOI,OLDSOI
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D BMES^XPDUTL("Adding 'ADV MED COST MGMT SOLUTION' as a new Source of Information")
  1.  D MES^XPDUTL("in the Source of Information File (#355.12) ... ")
  1.  ;
  1.  S NEWSOI(.01)=22,NEWSOI(.02)="ADV MED COST MGMT SOLUTION",NEWSOI(.03)="AMCMS"
  1.  ;
  1.  S IBCNT=22
  1.  I $D(^IBE(355.12,IBCNT)) D  Q   ; An SOI already exists in record #22.
  1.  . N PCCNT
  1.  . F PCCNT=.01:.01:.03 S OLDSOI(PCCNT)=$$GET1^DIQ(355.12,IBCNT,PCCNT,"I")
  1.  . ;
  1.  . I OLDSOI(.02)="ADV MED COST MGMT SOLUTION",OLDSOI(.03)="AMCMS" D  Q  ;'AMCMS' already exists.
  1.  . . D BMES^XPDUTL("ADV MED COST MGMT SOLUTION (AMCMS) entry was not installed.")
  1.  . . D MES^XPDUTL("It already exists in the Source Of Information file (#355.12).")
  1.  . ;
  1.  . ; Delete pre-existing SOI record #22 because it is not the AMCMS SOI.
  1.  . S DA=IBCNT S DIK="^IBE(355.12," D ^DIK
  1.  . S IBIEN=$$ADD^IBDFDBS(355.12,,.NEWSOI,.IBERR,IBCNT)
  1.  . I IBERR D  Q
  1.  . . D BMES^XPDUTL("*** ERROR ADDING "_NEWSOI(.02)_" CODE TO THE SOURCE OF INFORMATION TABLE (#355.12) - Log a Service Ticket! ***")
  1.  . D BMES^XPDUTL("Replaced record #22 ("_OLDSOI(.03)_") - "_OLDSOI(.02)_" with the new")
  1.  . D MES^XPDUTL("ADV MED COST MGMT SOLUTION (AMCMS) entry in the Source Of Information file")
  1.  . D MES^XPDUTL("(#355.12).")
  1.  . ;
  1.  . I PRODENV D   ; Send an email to the eInsurance Rapid Response Team.
  1.  . . N MSG,SUBJ,XMINSTR,XMTO
  1.  . . S SUBJ="IB*2*668 - AMCMS replaces existing SOI #"_$P(SITE,U,3)_" "_$P(SITE,U,2)
  1.  . . S SUBJ=$E(SUBJ,1,65)
  1.  . . S MSG(1)="On "_$$FMTE^XLFDT($$NOW^XLFDT)_" at Site # "_SITENUM_" - "_SITENAME_","
  1.  . . S MSG(2)="the installation of patch IB*2.0*668 added the new AMCMS - ADV"
  1.  . . S MSG(3)="MED COST MGMT SOLUTION entry to the Source Of Information file"
  1.  . . S MSG(4)="(#355.12) by removing the non-standardized entry #22 for"
  1.  . . S MSG(5)=OLDSOI(.03)_" - "_OLDSOI(.02)_"."
  1.  . . S MSG(6)=""
  1.  . . S XMTO("VHAeInsuranceRapidResponse@domain.ext")=""
  1.  . . ;
  1.  . . S XMINSTR("FROM")="VistA-eInsurance"
  1.  . . D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
  1.  ;
  1.  S IBIEN=$$ADD^IBDFDBS(355.12,,.NEWSOI,.IBERR,IBCNT)
  1.  I IBERR D  Q
  1.  . D BMES^XPDUTL("*** ERROR ADDING "_NEWSOI(.02)_" CODE TO THE SOURCE OF INFORMATION TABLE (#355.12) - Log a Service Ticket! ***")
  1.  D BMES^XPDUTL("Source of Information: ADV MED COST MGMT SOLUTION added successfully")
  1.  Q
  1.  ;