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