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

IBCNBAR.m

Go to the documentation of this file. 
  1. IBCNBAR ;ALB/ARH-Ins Buffer: process Accept and Reject ;15 Jan 2009
  1.  ;;2.0;INTEGRATED BILLING;**82,240,345,413,416,497,528,554,595,631,687,737**;21-MAR-94;Build 19
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;
  1. ACCEPT(IBBUFDA,DFN,IBINSDA,IBGRPDA,IBPOLDA,IBMVINS,IBMVGRP,IBMVPOL,IBMVSUB,IBNEWINS,IBNEWGRP,IBNEWPOL,IBELIG,IBSEL,IBRIEN,IBSIEN,IBFNAM,IBVAL,IBHOLD,IBXHOLD) ; move buffer data into Insurance files then cleanup
  1.  ;    1) data moved into insurance files, new records created if needed or edit existing ones
  1.  ;    2) complete some general functions that are executed whenever insurance is entered/edited
  1.  ;    3) allow user to view buffer entry and new/updated insurance records
  1.  ;    4) buffer ins/group/policy data deleted
  1.  ;    5) buffer entry status updated
  1.  ;
  1.  N RESULT,IBSUPRES
  1.  ;Set IBSUPRES to zero to not suppress I/O within Accept 
  1.  S IBSUPRES=0
  1.  ;
  1. PROCESS ; process all changes selected by user, add/edit insurance files based
  1.  ; on buffer data. Entry point for ACCEPAPI^IBCNICB (patch 413)
  1.  ;
  1.  N IVMINSUP,IBNEW,IBCDFN,RIEN S IBCDFN=IBPOLDA S:+IBNEWPOL IBNEW=1 D BEFORE^IBCNSEVT ; insurance event driver
  1.  ;
  1.  N DIR,X,Y,IBX,IBINSH,IBGRPH,IBPOLH,IBSUBH S (IBINSH,IBGRPH,IBPOLH,IBSUBH)="Updated" W:$G(IBSUPRES)'>0 " ...",!
  1.  ;
  1.  ;IB*737/CKB - if processing this entry would result in Effective Date (#2.312,8) being null, abort processing
  1.  I $G(IBCNICB) S IBSIEN=$S(+IBPOLDA:IBPOLDA_","_DFN_",",1:"")
  1.  S IBBUFABORT=$$EFFDTCHK(IBBUFDA,IBSIEN,+IBMVPOL) G:IBBUFABORT ACCPTQ
  1.  ;
  1.  S RESULT(0)="-1^Add new INSURANCE COMPANY failed"
  1.  I +IBNEWINS S IBINSDA=+$$NEWINS^IBCNBMN(IBBUFDA) G:'IBINSDA ACCPTQ  S IBINSH="Created",RESULT(1)="IBINSDA^"_IBINSDA
  1.  ;
  1.  S RESULT(0)="-1^Add new GROUP INSURANCE PLAN failed"
  1.  I +IBNEWGRP S IBGRPDA=+$$NEWGRP^IBCNBMN(IBBUFDA,+IBINSDA) G:'IBGRPDA ACCPTQ S IBGRPH="Created",RESULT(2)="IBGRPDA^"_IBGRPDA
  1.  ;
  1.  S RESULT(0)="-1^Add new patient insurance policy failed"
  1.  I +IBNEWPOL S IBPOLDA=+$$NEWPOL^IBCNBMN(IBBUFDA,+IBINSDA,+IBGRPDA) G:'IBPOLDA ACCPTQ S (IBPOLH,IBSUBH)="Created",RESULT(3)="IBPOLDA^"_IBPOLDA
  1.  ;
  1.  ;Only do this check for ICB ACCEPAPI^IBCNICB interface
  1.  S RESULT(0)="-1^Move TYPE parameter value="_IBMVINS_" is invalid"
  1.  I $G(IBSUPRES)>0,"^1^2^3^"'[("^"_IBMVINS_"^") Q
  1.  ;
  1.  S RESULT(0)="-1^Move buffer data to insurance files failed"
  1.  I +IBINSDA,+IBMVINS D INS^IBCNBMI(IBBUFDA,IBINSDA,+IBMVINS,.RESULT) W:$G(IBSUPRES)'>0 !,"Insurance Company "_IBINSH_"..."
  1.  I +IBINSDA,+IBMVGRP,+IBGRPDA D 
  1.  . D GRP^IBCNBMI(IBBUFDA,IBGRPDA,+IBMVGRP,.RESULT)
  1.  . ; For ICB Interface ensure INDIVIDUAL POLICY PATIENT (.1) field is
  1.  . ; appropriate for IS THIS A GROUP POLICY? (.02) field
  1.  . I $G(IBSUPRES)>0 D
  1.  . . N IBFLDS,IBISGRP,IBPAT
  1.  . . S IBISGRP=$$GET1^DIQ(355.3,IBGRPDA,.02,"I")
  1.  . . S IBPAT=$$GET1^DIQ(355.3,IBGRPDA,.1,"I")
  1.  . . ;Quit if Group Policy and .1 field isn't populated
  1.  . . I IBISGRP>0,IBPAT'>0 Q
  1.  . . ;Quit if Individual Policy and .1 field is populated.
  1.  . . I IBISGRP'>0,IBPAT>0 Q
  1.  . . ;Delete .1 field if Group Policy
  1.  . . I IBISGRP>0 S IBFLDS(355.3,IBGRPDA_",",.1)="@"
  1.  . . I IBISGRP'>0 S IBFLDS(355.3,IBGRPDA_",",.1)=DFN
  1.  . . D FILE^DIE("","IBFLDS","IBERR")
  1.  . W:$G(IBSUPRES)'>0 !,"Group/Plan "_IBGRPH_"..."
  1.  I +IBINSDA,+IBMVPOL,+IBGRPDA,+IBPOLDA D POLICY^IBCNBMI(IBBUFDA,IBPOLDA,+IBMVPOL,.RESULT) W:$G(IBSUPRES)'>0 !,"Patient Policy "_IBPOLH_"..."
  1.  ; I +IBELIG S RIEN=$O(^IBCN(365,"AF",IBBUFDA,""),-1) I RIEN D GRPFILE^IBCNEHL1(DFN,IBPOLDA,RIEN,0),EBFILE^IBCNEHL1(DFN,IBPOLDA,RIEN,0) W:$G(IBSUPRES)'>0 !,"Eligibility/Benfits data Updated..."
  1.  ;
  1.  S RESULT(0)="-1^Move Patient Registration data into Insurance files failed"
  1.  I +IBINSDA,+$G(IBMVSUB),+IBGRPDA,+IBPOLDA D SUB^IBCNBMI(IBBUFDA,IBPOLDA,IBRIEN,IBSEL,+IBMVSUB,.RESULT,DFN,IBFNAM,IBVAL,.IBHOLD,.IBXHOLD) W:$G(IBSUPRES)'>0 !,"Subscriber Insurance Information "_IBSUBH_"..."
  1.  ;
  1.  I +IBELIG S RIEN=$O(^IBCN(365,"AF",IBBUFDA,""),-1) I RIEN D GRPFILE^IBCNEHL1(DFN,IBPOLDA,RIEN,0),EBFILE^IBCNEHL1(DFN,IBPOLDA,RIEN,0) W:$G(IBSUPRES)'>0 !,"Eligibility/Benefits data Updated..."  ;IB*2.0*554 Fix spelling error
  1.  ;
  1.  ;Only do this update for ICB ACCEPAPI^IBCNICB interface
  1.  I $G(IBSUPRES)>0,+IBMVPOL,+IBGRPDA,+IBPOLDA,'IBNEWPOL D UPDPOL^IBCNICB(.RESULT,IBBUFDA,DFN,IBINSDA,IBGRPDA,IBPOLDA)
  1.  ;
  1. CLEANUP ; general updates and checks done whenever insurance is added/edited and clean up buffer file
  1.  N IBSOURCE S IBSOURCE=$P($G(^IBA(355.33,IBBUFDA,0)),U,3)
  1.  N RELHLD S RELHLD=0
  1.  ;
  1.  ;Don't do PAT^IBCNBMI for ICB ACCEPAPI^IBCNICB interface
  1.  I $G(IBSUPRES)'>0,+IBPOLDA D PAT^IBCNBMI(DFN,IBPOLDA) ; update DOB&SSN of Pat Ins from Pat file
  1.  D POL^IBCNSU41(DFN) ; update Tricare sponsor data
  1.  D COVERED^IBCNSM31(DFN) ; update 'Covered by Insurance' field (2,.3192
  1.  I +IBSOURCE=3 D IVM(1,IBBUFDA,$G(IVMREPTR),$G(IBSUPRES)) ; update/notify IVM
  1.  ;Suppress Write in $$DUPCO^IBCNSOK1 if called from ICB Interface
  1.  I +IBINSDA,+IBPOLDA S IBX=$$DUPCO^IBCNSOK1(DFN,IBINSDA,IBPOLDA,$S($G(IBSUPRES)>0:0,1:1)) ; warning if duplicate policy added for patient
  1.  S RESULT(0)="0"_$S($G(IBX):"^Warning - Duplicate or inconsistent insurance data",1:"")
  1.  ;
  1.  ;Suppress Write in $$DUPPOL^IBCNSOK1 if called from ICB Interface
  1.  I +IBGRPDA S IBX=$$DUPPOL^IBCNSOK1(IBGRPDA,$S($G(IBSUPRES)>0:0,1:1)) ; warning if duplicate plan was added
  1.  S:IBX RESULT(0)=RESULT(0)_"^Warning - Duplicate or inconsistent policy data"
  1.  ;
  1.  ;Suppress Write in $$PTHLD^IBOHCR if called from ICB Interface
  1.  I +IBNEWPOL I +$$PTHLD^IBOHCR(DFN,1,$S($G(IBSUPRES)>0:0,1:1)) D
  1.  . W:$G(IBSUPRES)'>0 !!,"Patient's bills On Hold date updated due to new insurance."
  1.  . S RESULT(0)=RESULT(0)_"^Patient's bills On Hold date updated due to new insurance"
  1.  ;
  1.  I $$HOLD^IBCNBLL(DFN) D
  1.  . W:$G(IBSUPRES)'>0 !!,"There are bills On Hold for this patient."
  1.  . S RESULT(0)=RESULT(0)_"^There are bills On Hold for this patient"
  1.  ;
  1.  ;Suppress DIR call functionality for ICB ACCEPAPI^IBCNICB interface
  1.  D:$G(IBSUPRES)'>0
  1.  . W !! S DIR(0)="FO",DIR("A")="Press 'V' to view the changes or Return to continue" D ^DIR
  1.  . I Y="V"!(Y="v") D
  1.  . . W !!
  1.  . . D INS^IBCNBCD(IBBUFDA,IBINSDA),WAIT^IBCNBUH
  1.  . . D GRP^IBCNBCD(IBBUFDA,IBGRPDA),WAIT^IBCNBUH
  1.  . . D POLICY^IBCNBCD(IBBUFDA,IBPOLDA),WAIT^IBCNBUH
  1.  . . S IBSIEN=$S(+IBPOLDA:IBPOLDA_","_DFN_",",1:0)
  1.  . . I +IBSIEN,+$G(IBSEL) D SBDISP^IBCNBCD4(IBBUFDA,DFN,IBPOLDA,IBSEL,IBRIEN,IBSIEN,IBFNAM,IBVAL,.IBHOLD,.IBXHOLD),WAIT^IBCNBUH
  1.  ;
  1.  ; IB*2.0*631/TAZ Add CREATION TO PROCESSING Tracking
  1.  D TRACK
  1.  ;
  1.  ;IB*687/TAZ - File Accepted policy in INTERFACILITY INSURANCE UPDATE File (#365.19)
  1.  ;IBCNICB was set in routine IBCNICB. It will let us know if the buffer entry in file #355.33 was processed by
  1.  ; the COTS ICB product. This field will be used set ICB PROCESSED BUFFER (#365.19,1.08).
  1.  D LOC^IBCNIUF(DFN,IBINSDA,IBPOLDA,,IBBUFDA,$$GET1^DIQ(355.33,IBBUFDA_",",.03,"E"),$G(IBCNICB))
  1.  ;
  1.  ; IB*2*595/DM if SOI is eIV, update insurance record IEN field in response file (#365/.12)
  1.  I $P(^IBA(355.33,IBBUFDA,0),U,3)=$$FIND1^DIC(355.12,,,"eIV","C") D UPDIREC^IBCNEHL3($O(^IBCN(365,"AF",IBBUFDA,"")),IBPOLDA)
  1.  ; update buffer file entry so only stub remains and status is changed
  1.  D STATUS^IBCNBEE(IBBUFDA,"A",IBNEWINS,IBNEWGRP,IBNEWPOL) ; update buffer entry's status to accepted
  1.  D DELDATA^IBCNBED(IBBUFDA) ; delete buffer's insurance/patient data
  1.  ;
  1.  ; IB*2.0*554
  1.  I $$HOLD^IBCNBLL(DFN),'$$BUFFER^IBCNBU1(DFN) D RELHLD(DFN)
  1.  ;I +DFN,RELHLD D
  1.  ;. ;Suppress Write in $$PTHLD^IBOHCR if called from ICB Interface
  1.  ;. I +$$PTHLD^IBOHCR(DFN,2,$S($G(IBSUPRES)>0:0,1:1)) D
  1.  ;. . I $G(IBSUPRES)'>0 W !!,"Patient has no other active Insurance.",!,"All patient bills On Hold waiting for Insurance to be released." D WAIT^IBCNBUH
  1.  ;. . S RESULT=$G(RESULT)_"^Patient has no other active Insurance.  All patient bills On Hold waiting for Insurance to be released."
  1.  ;
  1.  S IBCDFN=IBPOLDA S:+IBSOURCE=3 IVMINSUP=1 D AFTER^IBCNSEVT,^IBCNSEVT ; insurance event driver
  1.  ;
  1. ACCPTQ Q
  1.  ;
  1. REJECT(IBBUFDA) ; process a buffer entry reject
  1.  ;    1) update/notify IVM
  1.  ;    2) buffer ins/group/policy data deleted
  1.  ;    3) buffer entry status updated
  1.  ;    4) if patient has no other active insurance then release any patient bills On Hold
  1.  ;
  1.  N IBSUPRES,RESULT,RELHLD
  1.  ;Set IBSUPRES to 0 to not suppress I/O within REJECT
  1.  S IBSUPRES=0,RELHLD=0
  1.  ;
  1. REJPROC ;Entry point for REJECAPI^IBCNICB (Patch 413)
  1.  ;
  1.  N DFN S DFN=+$G(^IBA(355.33,+IBBUFDA,60))
  1.  N RELHLD S RELHLD=0
  1.  S RESULT="-1^PATIENT IEN MISSING FROM BUFFER ENTRY" Q:'$G(DFN)
  1.  I +$P($G(^IBA(355.33,+IBBUFDA,0)),U,3)=3 D IVM(0,IBBUFDA,$G(IVMREPTR),$G(IBSUPRES))
  1.  ;
  1.  ; IB*2.0*631/TAZ Add CREATION TO PROCESSING Tracking
  1.  D TRACK
  1.  ;
  1.  S RESULT=0
  1.  D STATUS^IBCNBEE(+IBBUFDA,"R",0,0,0),DELDATA^IBCNBED(+IBBUFDA) W:$G(IBSUPRES)'>0 " ... done."
  1.  ;
  1.  ; IB*2.0*554
  1.  I $$HOLD^IBCNBLL(DFN),'$$BUFFER^IBCNBU1(DFN) D RELHLD(DFN)
  1.  ;I +DFN,RELHLD D
  1.  ;. ;Suppress Write in $$PTHLD^IBOHCR if called from ICB Interface
  1.  ;. I +$$PTHLD^IBOHCR(DFN,2,$S($G(IBSUPRES)>0:0,1:1)) D
  1.  ;. . I $G(IBSUPRES)'>0 W !!,"Patient has no other active Insurance.",!,"All patient bills On Hold waiting for Insurance to be released." D WAIT^IBCNBUH
  1.  ;. . S RESULT=$G(RESULT)_"^Patient has no other active Insurance.  All patient bills On Hold waiting for Insurance to be released."
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. IVM(AR,IBBUFDA,IVMREPTR,IBSUPRES) ; IVM must be notified whenever a buffer entry
  1.  ; that originated in IVM is accepted or rejected. This lets IVM clean up
  1.  ; its files since IVM also has a buffer type file of insurance uploaded
  1.  ; from the IVM center.
  1.  ; If rejected and Interactive Reads not suppressed, IVM then ask the 
  1.  ; user for a reason it was rejected
  1.  ; input:  AR = 1 if accepted, 0 if rejected
  1.  ;    IBBUFDA = Internal Entry Number to 355.33 file
  1.  ;   IVMREPTR = Internal Entry Number to 301.91 file (Optional)
  1.  ;   IBSUPRES = If equals 1, suppress writes and interactive reads
  1.  ;
  1.  N DFN,IBX,IBY I $P($G(^IBA(355.33,+IBBUFDA,0)),U,3)'=3 Q
  1.  ;
  1.  S DFN=+$G(^IBA(355.33,+IBBUFDA,60))
  1.  S IBX=$P($G(^IBA(355.33,+IBBUFDA,20)),U,1)_U_$P($G(^IBA(355.33,+IBBUFDA,21)),U,1)_U_$P($G(^IBA(355.33,+IBBUFDA,90)),U,2)  ; IB*2.0*497 (vd)
  1.  ;
  1.  S IBY=$$UPDATE^IVMLINS4(DFN,AR,IBX,$G(IVMREPTR),$G(IBSUPRES))
  1.  Q
  1.  ; ;IB*2.0*554
  1. RELHLD(DFN) ;Check if need to release copay on hold
  1.  N IBN,X3,X5,IBX,IBFR,IBAT,IBCAT,IBTALK,IBVDT
  1.  S IBTALK=$S($G(IBSUPRES)>0:0,1:1)
  1.  S IBN=0
  1.  F  S IBN=$O(^IB("AH",DFN,IBN)) Q:IBN=""  D
  1.  . S IBX=$G(^IB(IBN,0))
  1.  . S X5=+$P(IBX,U,5) Q:X5'=8
  1.  . S IBFR=$P(IBX,U,14)
  1.  . S X3=$P(IBX,U,3)
  1.  . S IBVDT=$S(IBFR'="":IBFR,1:DT),IBAT=$P(^IBE(350.1,X3,0),U,11)
  1.  . S IBCAT=$S(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
  1.  . S IBCAT=$O(^IBE(355.31,"B",IBCAT,""))
  1.  . D CHKREL(DFN,IBVDT,IBN,IBCAT)
  1.  Q
  1.  ;
  1. CHKREL(DFN,IBINDT,IBN,IBCAT) ; -- release copay
  1.  ; --Input  DFN     = patient
  1.  ;          IBINDT  = date to check
  1.  ;          IBN     = ien of copay on hold
  1.  ;          IBCAT   = category of hold
  1.  ; will determine if hold should be released
  1.  ;
  1.  N IBCOV,IBDD,PLAN,POLCY,TRICHP,COV,CNT,TYPNAM,X,PLAN,ANYINS,INS,CHKCOV,PLNTYP
  1.  S (IBCOV,CNT,COV,TRICHP,POLCY)=0
  1.  I IBINDT="" S IBINDT=DT
  1.  S IBINDT=IBINDT\1
  1.  D ALL^IBCNS1(DFN,"IBDD",2,IBINDT) ;All active ins policies returned in IBDD array
  1.  S ANYINS=($O(IBDD(0))'="")
  1.  I 'ANYINS D RELEASE^IBOHCR(IBN) Q
  1.  F  S POLCY=$O(IBDD(POLCY)) Q:'POLCY  D
  1.  . S X=IBDD(POLCY,0)
  1.  . S PLAN=$P(X,U,18) I PLAN="" Q
  1.  . S INS=$P(X,U,1)_","
  1.  . S COV=$$GET1^DIQ(36,INS,1,"I") S COV=$S(COV="N":0,1:1)
  1.  . S TYPNAM=$$GET1^DIQ(36,INS,.13,"E"),CNT=CNT+1
  1.  . S:TYPNAM["TRICARE" TRICHP=1 S:TYPNAM["CHAMPVA" TRICHP=1
  1.  . I TYPNAM'["TRICARE",TYPNAM'["CHAMPVA",COV D
  1.  . . I 'IBCOV S IBCOV=$$PLCOV^IBCNSU3(PLAN,IBINDT,IBCAT)
  1.  ; remove hold if only has TRICARE OR CHAMPVA
  1.  I $G(CNT)=1,TRICHP D RELEASE^IBOHCR(IBN) Q
  1.  ; remove hold if multiple coverage and TRICARE or CHAMPVA and no ibcov
  1.  I $G(CNT)>1,TRICHP I 'IBCOV D RELEASE^IBOHCR(IBN) Q
  1.  ; remove hold if no TRICARE or CHAMPVA and no ibcov
  1.  I 'TRICHP,'IBCOV D RELEASE^IBOHCR(IBN)
  1.  Q
  1.  ;
  1.  ;IB*2.0*631/TAZ Added Tracking for CREATION TO PROCESSING TRACKING File
  1. TRACK ;Build CREATION TO PROCESSING TRACKING File (#355.36)
  1.  N ERROR,FDA,IBMSG,RESP,SOI,TQN,WE
  1.  S WE=""
  1.  S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) I RESP D
  1.  . S TQN=$$GET1^DIQ(365,RESP_",",.05,"I")
  1.  . S WE=$$GET1^DIQ(365.1,TQN_",",.1,"I")
  1.  . S SOI=$$GET1^DIQ(365.1,TQN_",",3.02,"I")
  1.  I 'RESP D
  1.  . ; Get data when a user processes a buffer entry before EIV can create an HL7 for a transmission
  1.  . S TQN=$O(^IBCN(365.1,"D",IBBUFDA,""),-1)
  1.  . I TQN D  Q
  1.  .. S WE=$$GET1^DIQ(365.1,TQN_",",.1,"I")
  1.  .. S SOI=$$GET1^DIQ(365.1,TQN_",",3.02,"I")
  1.  . S WE=6
  1.  . S SOI=$$GET1^DIQ(355.33,IBBUFDA_",",.03,"I")
  1.  I WE=7 Q   ; Do not want to track.
  1.  S FDA(355.36,"+1,",.01)=$$NOW^XLFDT ; DATE PROCESSED
  1.  S FDA(355.36,"+1,",.02)=$S("^1^2^3^4^"[(U_WE_U):2,"^5^6^"[(U_WE_U):4,1:"") ;TYPE OF PROCESSING
  1.  S FDA(355.36,"+1,",.03)=SOI ; SOURCE OF INFORMATION
  1.  S FDA(355.36,"+1,",.04)=0 ; EIV AUTO-UPDATE (always 0 for No if it hits this code.)
  1.  S FDA(355.36,"+1,",.05)=$G(TQN) ; EIV INQUIRY
  1.  S FDA(355.36,"+1,",.06)=RESP ; EIV RESPONSE
  1.  S FDA(355.36,"+1,",.07)=$G(IBBUFDA) ; BUFFER
  1.  S FDA(355.36,"+1,",.08)=WE ; WHICH EXTRACT (SOURCE OF REQUEST)
  1.  D UPDATE^DIE("","FDA",,"ERROR")
  1.  ;
  1.  I $D(ERROR) D
  1.  . D MSG003^IBCNEMS1(.IBMSG,.ERROR,TQN,RESP,$G(IBBUFDA))
  1.  . D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error writing to the CREATION TO PROCESSING TRACKING File (#355.36)","IBMSG(")
  1.  Q
  1.  ;
  1. EFFDTCHK(IBBUFDA,IBSIEN,IBMVPOL) ;
  1.  ;IB*737/CKB - if processing this entry would result in Effective Date (#2.312,8) being null,
  1.  ;             abort processing by returning 1
  1.  ; 
  1.  ;
  1.  ;Can't ACCEPT the entry if the Eff Date (#355.33,60.02) is null (includes Replace scenario)
  1.  ;
  1.  ;Overwrite - can't ACCEPT the entry if:
  1.  ;      Exp Date (#355.33,60.03) is null;
  1.  ;      AND Exp Date (#2.312,3) is NOT null;
  1.  ;      AND Eff Date (#355.33,60.02) > Exp Date (#2.312,3)
  1.  ;
  1.  ;Merge - can't ACCEPT the entry if:
  1.  ;      Exp Date (#2.312,3) is NOT null;
  1.  ;      AND Eff Date (#2.312,8) is null;
  1.  ;      AND Eff Date (#355.33,60.02) > Exp Date (#2.312,3);
  1.  ;      AND Exp Date (#355.33,60.03) is null
  1.  ;
  1.  ;Individual - can't ACCEPT the entry if:
  1.  ;      Exp Date (#2.312,3) is NOT null;
  1.  ;      AND Eff Date (#355.33,60.02) > Exp Date (#2.312,3);
  1.  ;      AND User answered YES to Accept Eff Date (#355.33,60.02) - adds to ^TMP($J,"IB BUFFER SELECTED",60.02);
  1.  ;      AND (User answered NO to Accept Exp Date (#355.33,60.03) OR (#355.33,60.03) is null)
  1.  ;
  1.  N ABORT,BUFEFFDT,BUFEXPDT,CHGEFFDT,CHGEXPDT,INSEFFDT,INSEXPDT
  1.  S ABORT=0
  1.  S BUFEFFDT=$$GET1^DIQ(355.33,IBBUFDA_",",60.02,"I")
  1.  S BUFEXPDT=$$GET1^DIQ(355.33,IBBUFDA_",",60.03,"I")
  1.  S INSEFFDT=$$GET1^DIQ(2.312,IBSIEN,8,"I")
  1.  S INSEXPDT=$$GET1^DIQ(2.312,IBSIEN,3,"I")
  1.  ;
  1.  ;Check Buffer Eff and Exp Date to ensure they are valid dates, if not abort processing
  1.  ; Abort processing if Buffer Eff Date is a "" (null) date
  1.  I $$VALIDDT^IBCNINSU(BUFEFFDT)<1 S ABORT=1 G EFFDTCHKQ
  1.  ; Allow the Buffer Exp Date to have a "" (null) date, this date is evaluated below
  1.  I $$VALIDDT^IBCNINSU(BUFEXPDT)<0 S ABORT=1 G EFFDTCHKQ
  1.  ;
  1.  I $G(IBSIEN)="" G EFFDTCHKQ  ; buffer okay, can't corrupt existing policy as it's a new policy
  1.  I INSEXPDT="" G EFFDTCHKQ    ; buffer entry okay to process
  1.  ;
  1.  ;   IBMVPOL = 1:Merge, 2:Overwrite, 3:Replace, 4:Individual 
  1.  I IBMVPOL=2 I (BUFEXPDT="")&(INSEXPDT'="")&(BUFEFFDT>INSEXPDT) S ABORT=1 G EFFDTCHKQ
  1.  ;
  1.  I IBMVPOL=1 I INSEFFDT=""&(BUFEFFDT>INSEXPDT)&(BUFEXPDT="") S ABORT=1 G EFFDTCHKQ
  1.  ;
  1.  I IBMVPOL=4 D
  1.  . S CHGEFFDT=$D(^TMP($J,"IB BUFFER SELECTED",60.02))  ; user wants to change the Effective Date
  1.  . S CHGEXPDT=$D(^TMP($J,"IB BUFFER SELECTED",60.03))  ; user wants to change the Expiration Date
  1.  . I (BUFEFFDT>INSEXPDT)&(CHGEFFDT)&((CHGEXPDT="")!(BUFEXPDT="")) S ABORT=1
  1.  ;
  1. EFFDTCHKQ ;
  1.  Q ABORT