IBCNINS ;AITC/TAZ - NIGHTLY INSURANCE PROCESS ; 23-NOV-2020
;;2.0;INTEGRATED BILLING;**687,771,806**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ;Main Entry Point for Nightly Process
;
; Checking for non-human users
D CHKPER
;
; Add Buffer Cleanup, Reject Duplicate entries - IB*806/CKB
N IBNUM,IBQUAL,IBRUN
; Only run if the proxy user 'IB,BUFFER CLEANUP' exists
I +$$FIND1^DIC(200,,"MX","IB,BUFFER CLEANUP") D
. ;IBRUN=1 Run cleanup ; IBQUAL="A"=All/"N"=# of entries ; IBNUM=(IBQUAL=A)=""/(IBQUAL=N)=# of entries
. S IBRUN=1,IBQUAL="A",IBNUM=""
. D BUFCLN^IBJPI3(IBRUN,IBQUAL,IBNUM)
;
; Process Nightly IIU Cleanup if IIU is Nationally Enabled.
I $$GET1^DIQ(350.9,"1,",53.01,"I")="Y" D NIGHT^IBCNIUHL
;
; Purge IIU File (#365.19) honoring the parameters in file (#350.9)
D EN^IBCNIUK
;
; Process Nightly eIV Process
D EN^IBCNEDE
;
; Send Daily Buffer Report email - Summary Version from production sites only
I $$PROD^XUPROD(1) D DBR^IBCNOR2
;
ENQ ;Exit
Q
;
;-------------------------------------------------------
CHKPER ;
; Check for the existence of the New Person (#200) entries listed below.
; Send a mailman message to "VHAeInsuranceRapidResponse@domain.ext" if any are missing.
; Entries to check: "INTERFACE,IB IIU", "INTERFACE,IB EIV", "AUTOUPDATE,IBEIV", "IB,BUFFER CLEANUP"
N IBAUTO,IBEIV,IBIIU,WKDT,IBMCT,MSG,MGRP,IBXMY
N IBBUFCLN S IBBUFCLN="" ;IB*806/DTG new var for IB Buffer Cleanup
;
S IBIIU=+$$FIND1^DIC(200,,"MX","INTERFACE,IB IIU")
S IBAUTO=+$$FIND1^DIC(200,,"MX","AUTOUPDATE,IBEIV"),IBEIV=+$$FIND1^DIC(200,,"MX","INTERFACE,IB EIV")
S IBBUFCLN=+$$FIND1^DIC(200,,"MX","IB,BUFFER CLEANUP") ; IB*806/DTG new var for IB Buffer Cleanup
;I IBIIU,IBAUTO,IBEIV Q
I IBIIU,IBAUTO,IBEIV,IBBUFCLN Q ; IB*806/DTG new var for IB Buffer Cleanup
;
S WKDT=$$SITE^VASITE()
S MSG(1)="Missing EIV New Person entries, for station "_$P(WKDT,U,3)_":"_$P(WKDT,U,2)
S MSG(2)="-------------------------------------------------------------------------------"
S IBMCT=2
I 'IBIIU S MSG(IBMCT)="Entry for 'INTERFACE,IB IIU' is missing",IBMCT=IBMCT+1
I 'IBAUTO S MSG(IBMCT)="Entry for 'AUTOUPDATE,IBEIV' is missing",IBMCT=IBMCT+1
I 'IBEIV S MSG(IBMCT)="Entry for 'INTERFACE,IB EIV' is missing",IBMCT=IBMCT+1
I 'IBBUFCLN S MSG(IBMCT)="Entry for 'IB,BUFFER CLEANUP' is missing",IBMCT=IBMCT+1
S MSG(IBMCT)="-------------------------------------------------------------------------------"
S MGRP=$$MGRP^IBCNEUT5()
;
; Check for production account and made sure eInsurance mailgroup is self documenting
I $$PROD^XUPROD(1) S IBXMY("VHAeInsuranceRapidResponse@domain.ext")=""
D MSG^IBCNEUT5(MGRP,"Missing eInsurance New Person entries ("_$P(WKDT,U,3)_")","MSG(",,.IBXMY) ;sends to postmaster if IBXMY is empty
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNINS 2869 printed Jan 29, 2026@15:14:48 Page 2
IBCNINS ;AITC/TAZ - NIGHTLY INSURANCE PROCESS ; 23-NOV-2020
+1 ;;2.0;INTEGRATED BILLING;**687,771,806**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ;Main Entry Point for Nightly Process
+1 ;
+2 ; Checking for non-human users
+3 DO CHKPER
+4 ;
+5 ; Add Buffer Cleanup, Reject Duplicate entries - IB*806/CKB
+6 NEW IBNUM,IBQUAL,IBRUN
+7 ; Only run if the proxy user 'IB,BUFFER CLEANUP' exists
+8 IF +$$FIND1^DIC(200,,"MX","IB,BUFFER CLEANUP")
Begin DoDot:1
+9 ;IBRUN=1 Run cleanup ; IBQUAL="A"=All/"N"=# of entries ; IBNUM=(IBQUAL=A)=""/(IBQUAL=N)=# of entries
+10 SET IBRUN=1
SET IBQUAL="A"
SET IBNUM=""
+11 DO BUFCLN^IBJPI3(IBRUN,IBQUAL,IBNUM)
End DoDot:1
+12 ;
+13 ; Process Nightly IIU Cleanup if IIU is Nationally Enabled.
+14 IF $$GET1^DIQ(350.9,"1,",53.01,"I")="Y"
DO NIGHT^IBCNIUHL
+15 ;
+16 ; Purge IIU File (#365.19) honoring the parameters in file (#350.9)
+17 DO EN^IBCNIUK
+18 ;
+19 ; Process Nightly eIV Process
+20 DO EN^IBCNEDE
+21 ;
+22 ; Send Daily Buffer Report email - Summary Version from production sites only
+23 IF $$PROD^XUPROD(1)
DO DBR^IBCNOR2
+24 ;
ENQ ;Exit
+1 QUIT
+2 ;
+3 ;-------------------------------------------------------
CHKPER ;
+1 ; Check for the existence of the New Person (#200) entries listed below.
+2 ; Send a mailman message to "VHAeInsuranceRapidResponse@domain.ext" if any are missing.
+3 ; Entries to check: "INTERFACE,IB IIU", "INTERFACE,IB EIV", "AUTOUPDATE,IBEIV", "IB,BUFFER CLEANUP"
+4 NEW IBAUTO,IBEIV,IBIIU,WKDT,IBMCT,MSG,MGRP,IBXMY
+5 ;IB*806/DTG new var for IB Buffer Cleanup
NEW IBBUFCLN
SET IBBUFCLN=""
+6 ;
+7 SET IBIIU=+$$FIND1^DIC(200,,"MX","INTERFACE,IB IIU")
+8 SET IBAUTO=+$$FIND1^DIC(200,,"MX","AUTOUPDATE,IBEIV")
SET IBEIV=+$$FIND1^DIC(200,,"MX","INTERFACE,IB EIV")
+9 ; IB*806/DTG new var for IB Buffer Cleanup
SET IBBUFCLN=+$$FIND1^DIC(200,,"MX","IB,BUFFER CLEANUP")
+10 ;I IBIIU,IBAUTO,IBEIV Q
+11 ; IB*806/DTG new var for IB Buffer Cleanup
IF IBIIU
IF IBAUTO
IF IBEIV
IF IBBUFCLN
QUIT
+12 ;
+13 SET WKDT=$$SITE^VASITE()
+14 SET MSG(1)="Missing EIV New Person entries, for station "_$PIECE(WKDT,U,3)_":"_$PIECE(WKDT,U,2)
+15 SET MSG(2)="-------------------------------------------------------------------------------"
+16 SET IBMCT=2
+17 IF 'IBIIU
SET MSG(IBMCT)="Entry for 'INTERFACE,IB IIU' is missing"
SET IBMCT=IBMCT+1
+18 IF 'IBAUTO
SET MSG(IBMCT)="Entry for 'AUTOUPDATE,IBEIV' is missing"
SET IBMCT=IBMCT+1
+19 IF 'IBEIV
SET MSG(IBMCT)="Entry for 'INTERFACE,IB EIV' is missing"
SET IBMCT=IBMCT+1
+20 IF 'IBBUFCLN
SET MSG(IBMCT)="Entry for 'IB,BUFFER CLEANUP' is missing"
SET IBMCT=IBMCT+1
+21 SET MSG(IBMCT)="-------------------------------------------------------------------------------"
+22 SET MGRP=$$MGRP^IBCNEUT5()
+23 ;
+24 ; Check for production account and made sure eInsurance mailgroup is self documenting
+25 IF $$PROD^XUPROD(1)
SET IBXMY("VHAeInsuranceRapidResponse@domain.ext")=""
+26 ;sends to postmaster if IBXMY is empty
DO MSG^IBCNEUT5(MGRP,"Missing eInsurance New Person entries ("_$PIECE(WKDT,U,3)_")","MSG(",,.IBXMY)
+27 QUIT
