IBY737PR ;AITC/DTG PRE-Installation for IB patch 737; JUL 26, 2022
;;2.0;INTEGRATED BILLING;**737**;MAR 21,1994;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to ^XPDUTL in ICR #10141
Q
;
PRE ; pre-install
;
N IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
; total number of work items
S XPDIDTOT=1
;
S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
;
D MES^XPDUTL("")
;
D BMES^XPDUTL("PRE-INSTALL for IB*2.0*737 at "_$G(SITENAME)_":"_$G(SITENUM)_" Starting.")
;
D REMCODE(1) I $G(XPDABORT) G PREX ; remove '~NO PAYER' from PAYER File
;
D BMES^XPDUTL("PRE-INSTALL for IB*2.0*737 at "_$G(SITENAME)_":"_$G(SITENUM)_" Finished.")
;
PREX ;
Q
;============================
;
REMCODE(IBXPD) ; remove '~NO PAYER' from PAYER File (#365.12)
;
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Removing Payer '~NO PAYER' from the PAYER File (#365.12).")
N DA,DIK,ERR,IBXMY,MSG,PIEN,RES
;
; first get IEN from 365.12
S PIEN=$$FIND1^DIC(365.12,,"X","~NO PAYER")
;
;Not found
I PIEN=0 S RES="Payer '~NO PAYER' not found in PAYER File (#365.12), which is okay." G REMCODEX
;
;ERROR Encountered
I PIEN="" D G REMCODEX
. S RES="Error encountered - "_$G(ERR("DIERR",1,"TEXT",1))
. S XPDABORT=1
;
; remove item from file
S DIK="^IBE(365.12,",DA=PIEN
D ^DIK
;
; was it removed
S PIEN=$$FIND1^DIC(365.12,,"X","~NO PAYER")
;
;if not removed
I PIEN S RES=" Not able to remove '~NO PAYER' from PAYER File (#365.12), which is an issue." S XPDABORT=1 G REMCODEX
S RES="Payer '~NO PAYER' has been removed from the PAYER File (#365.12)."
;
REMCODEX ;
I '$G(XPDABORT) D BMES^XPDUTL(RES)
I $G(XPDABORT) D
. S MSG(1)=""
. S MSG(2)=" ***** PATCH IB*2.0*737 ABORTED *****"
. S MSG(3)=""
. S MSG(4)="Removal of the '~NO PAYER' Payer has failed."
. S MSG(5)="INSTALLER: Please log a Service NOW (SNOW) Ticket to have the"
. S MSG(6)="'~NO PAYER' entry removed from the PAYER File (#365.12)."
. S MSG(7)=""
. ; Only send to eInsurance Rapid Response if in Production
. ; 1=Production Environment, 0=Test Environment
. I $$PROD^XUPROD(1) S IBXMY("VHAeInsuranceRapidResponse@domain.ext")=""
. D MSG^IBCNEUT5(,"~NO PAYER not removed at ("_SITENUM_"-"_SITENAME_")","MSG(",,.IBXMY)
. D BMES^XPDUTL(.MSG)
. D REOPT
Q
;
REOPT ;Re-enable Options
;IBCN INS RPTS - Insurance Reports Menu
I $$OPTDE^XPDUTL("IBCN INS RPTS",1) D BMES^XPDUTL("Option [IBCN INS RPTS] Enabled.")
;IBJ MCCR SITE PARAMETERS - MCCR Site Parameter Display/Edit
I $$OPTDE^XPDUTL("IBJ MCCR SITE PARAMETERS",1) D BMES^XPDUTL("Option [IBJ MCCR SITE PARAMETERS] Enabled.")
;IBCNE PAYER EDIT - Payer Edit
I $$OPTDE^XPDUTL("IBCNE PAYER EDIT",1) D BMES^XPDUTL("Option [IBCNE PAYER EDIT] Enabled.")
;IBCN INSURANCE BUFFER PROCESS - Process Insurance Buffer
I $$OPTDE^XPDUTL("IBCN INSURANCE BUFFER PROCESS",1) D BMES^XPDUTL("Option [IBCN INSURANCE BUFFER PROCESS] Enabled.")
;IBCNE REQUEST INQUIRY - Request Electronic Insurance Inquiry
I $$OPTDE^XPDUTL("IBCNE REQUEST INQUIRY",1) D BMES^XPDUTL("Option [IBCNE REQUEST INQUIRY] Enabled.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY737PR 3215 printed Apr 09, 2024@21:16:43 Page 2
IBY737PR ;AITC/DTG PRE-Installation for IB patch 737; JUL 26, 2022
+1 ;;2.0;INTEGRATED BILLING;**737**;MAR 21,1994;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to ^XPDUTL in ICR #10141
+5 QUIT
+6 ;
PRE ; pre-install
+1 ;
+2 NEW IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
+3 ; total number of work items
+4 SET XPDIDTOT=1
+5 ;
+6 SET SITE=$$SITE^VASITE
SET SITENAME=$PIECE(SITE,U,2)
SET SITENUM=$PIECE(SITE,U,3)
+7 ;
+8 DO MES^XPDUTL("")
+9 ;
+10 DO BMES^XPDUTL("PRE-INSTALL for IB*2.0*737 at "_$GET(SITENAME)_":"_$GET(SITENUM)_" Starting.")
+11 ;
+12 ; remove '~NO PAYER' from PAYER File
DO REMCODE(1)
IF $GET(XPDABORT)
GOTO PREX
+13 ;
+14 DO BMES^XPDUTL("PRE-INSTALL for IB*2.0*737 at "_$GET(SITENAME)_":"_$GET(SITENUM)_" Finished.")
+15 ;
PREX ;
+1 QUIT
+2 ;============================
+3 ;
REMCODE(IBXPD) ; remove '~NO PAYER' from PAYER File (#365.12)
+1 ;
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Removing Payer '~NO PAYER' from the PAYER File (#365.12).")
+5 NEW DA,DIK,ERR,IBXMY,MSG,PIEN,RES
+6 ;
+7 ; first get IEN from 365.12
+8 SET PIEN=$$FIND1^DIC(365.12,,"X","~NO PAYER")
+9 ;
+10 ;Not found
+11 IF PIEN=0
SET RES="Payer '~NO PAYER' not found in PAYER File (#365.12), which is okay."
GOTO REMCODEX
+12 ;
+13 ;ERROR Encountered
+14 IF PIEN=""
Begin DoDot:1
+15 SET RES="Error encountered - "_$GET(ERR("DIERR",1,"TEXT",1))
+16 SET XPDABORT=1
End DoDot:1
GOTO REMCODEX
+17 ;
+18 ; remove item from file
+19 SET DIK="^IBE(365.12,"
SET DA=PIEN
+20 DO ^DIK
+21 ;
+22 ; was it removed
+23 SET PIEN=$$FIND1^DIC(365.12,,"X","~NO PAYER")
+24 ;
+25 ;if not removed
+26 IF PIEN
SET RES=" Not able to remove '~NO PAYER' from PAYER File (#365.12), which is an issue."
SET XPDABORT=1
GOTO REMCODEX
+27 SET RES="Payer '~NO PAYER' has been removed from the PAYER File (#365.12)."
+28 ;
REMCODEX ;
+1 IF '$GET(XPDABORT)
DO BMES^XPDUTL(RES)
+2 IF $GET(XPDABORT)
Begin DoDot:1
+3 SET MSG(1)=""
+4 SET MSG(2)=" ***** PATCH IB*2.0*737 ABORTED *****"
+5 SET MSG(3)=""
+6 SET MSG(4)="Removal of the '~NO PAYER' Payer has failed."
+7 SET MSG(5)="INSTALLER: Please log a Service NOW (SNOW) Ticket to have the"
+8 SET MSG(6)="'~NO PAYER' entry removed from the PAYER File (#365.12)."
+9 SET MSG(7)=""
+10 ; Only send to eInsurance Rapid Response if in Production
+11 ; 1=Production Environment, 0=Test Environment
+12 IF $$PROD^XUPROD(1)
SET IBXMY("VHAeInsuranceRapidResponse@domain.ext")=""
+13 DO MSG^IBCNEUT5(,"~NO PAYER not removed at ("_SITENUM_"-"_SITENAME_")","MSG(",,.IBXMY)
+14 DO BMES^XPDUTL(.MSG)
+15 DO REOPT
End DoDot:1
+16 QUIT
+17 ;
REOPT ;Re-enable Options
+1 ;IBCN INS RPTS - Insurance Reports Menu
+2 IF $$OPTDE^XPDUTL("IBCN INS RPTS",1)
DO BMES^XPDUTL("Option [IBCN INS RPTS] Enabled.")
+3 ;IBJ MCCR SITE PARAMETERS - MCCR Site Parameter Display/Edit
+4 IF $$OPTDE^XPDUTL("IBJ MCCR SITE PARAMETERS",1)
DO BMES^XPDUTL("Option [IBJ MCCR SITE PARAMETERS] Enabled.")
+5 ;IBCNE PAYER EDIT - Payer Edit
+6 IF $$OPTDE^XPDUTL("IBCNE PAYER EDIT",1)
DO BMES^XPDUTL("Option [IBCNE PAYER EDIT] Enabled.")
+7 ;IBCN INSURANCE BUFFER PROCESS - Process Insurance Buffer
+8 IF $$OPTDE^XPDUTL("IBCN INSURANCE BUFFER PROCESS",1)
DO BMES^XPDUTL("Option [IBCN INSURANCE BUFFER PROCESS] Enabled.")
+9 ;IBCNE REQUEST INQUIRY - Request Electronic Insurance Inquiry
+10 IF $$OPTDE^XPDUTL("IBCNE REQUEST INQUIRY",1)
DO BMES^XPDUTL("Option [IBCNE REQUEST INQUIRY] Enabled.")
+11 QUIT
