IBCNBLL ;ALB/ARH - Ins Buffer: LM main screen, list buffer entries ;1 Jun 97
;;2.0;INTEGRATED BILLING;**82,149,153,183,184,271,345,416,438,435,506,519,528,549,601,595,631,664,668,737,771,794**;21-MAR-94;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
; DBIA# 642 for call to $$LST^DGMTU
; DBIA# 4433 for call to $$SDAPI^SDAMA301
;
EN ; - main entry point for screen
N VIEW,AVIEW,DFLG,IBKEYS
S VIEW=6,AVIEW=0 ; default to complete view ;IB*2*506/taz changed
K ^TMP("IBCNERTQ",$J) ; clear temp. global for eIV real time inquiries
D EN^VALM("IBCNB INSURANCE BUFFER LIST")
Q
;
EN1(V) ; entry point from view changing actions
S VIEW=V S AVIEW=$S(VIEW=4:1,1:0)
D INIT,HDR
S VALMBCK="R",VALMBG=1
Q
;
HDR ; header code for list manager display
S VALMHDR(1)="Sorted by: "_$P(IBCNSORT,U,2)
I $P(IBCNSORT,U,3)'="" S VALMHDR(1)=VALMHDR(1)_", """_$P(IBCNSORT,U,3)_""" first"
; IB*2.0*737/DTG remove '* verified' reference from VALMSG,
; impacts views 1-3 and 5
; I VIEW=1 S VALM("TITLE")="Positive Insurance Buffer",VALMSG="*Verified +Active" ;IB*2*506/taz Only shows Verified and Active records.
; I VIEW=2 S VALM("TITLE")="Negative Insurance Buffer",VALMSG="*Verified -N/Active" ;IB*2*506/taz Only shows Verified and N/Active records.
; I VIEW=3 S VALM("TITLE")="Medicare(WNR) Insurance Buffer",VALMSG="*Verified +Act -N/Act ?Await/R #Unclr !Unable/Send"
; I VIEW=5 S VALM("TITLE")="e-Pharmacy Buffer",VALMSG="*Verified" ; IB*2*435
I VIEW=1 S VALM("TITLE")="Positive Insurance Buffer",VALMSG="+Active" ;IB*2*506/taz & IB*737 Active policies only
I VIEW=2 S VALM("TITLE")="Negative Insurance Buffer",VALMSG="-N/Active" ;IB*2*506/taz & IB*737 Inactive policies only
I VIEW=3 S VALM("TITLE")="Medicare(WNR) Insurance Buffer",VALMSG="+Act -N/Act ?Await/R #Unclr !Unable/Send" ; IB737 removed *Verified
I VIEW=4 S VALM("TITLE")="Failure Buffer",VALMSG="!Unable/Send" ;IB*2*506/taz changed
I VIEW=5 S VALM("TITLE")="e-Pharmacy Buffer",VALMSG="" ; IB*2*435 & IB*737 dropped "*Verified"
I VIEW=6 S VALM("TITLE")="Complete Buffer",VALMSG="" ; IB*2*506/taz added
I VIEW=7 S VALM("TITLE")="TRICARE/CHAMPVA",VALMSG="" ;528/baa added
Q
;
INIT ; initialization for list manager list
K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS"),^TMP($J,"IBCNAPPTS")
; IB*2.0*737/DTG correct IBCNSORT due to removed "*"
; S:$G(IBCNSORT)="" IBCNSORT=$S(VIEW=1:"10^Positive Response",1:"1^Patient Name")
;IB*794/DTG if sort is null default to patient name for all
;S:$G(IBCNSORT)="" IBCNSORT=$S(VIEW=1:"9^Positive Response",1:"1^Patient Name")
S:$G(IBCNSORT)="" IBCNSORT="1^Patient Name"
S IBKEYS=$$GETKEYS(DUZ) ;IB*2*506/taz user must have either IB INSURANCE EDIT or IB GROUP/PLAN EDIT in order to view entries without defined insurance company entries
D BLD
Q
;
HELP ; list manager help
D FULL^VALM1
S VALMBCK="R"
W @IOF
W !,"Flags displayed on screen if they apply to the Buffer entry:"
W !," i - Patient has other currently effective Insurance"
W !," I - Patient is currently admitted as an Inpatient"
W !," E - Patient has Expired"
W !," Y - Means Test Copay Patient"
W !," H - Patient has Bills On Hold"
; W !," * - Buffer entry Verified by User" ; IB*2.0*737 removed
W !
D PAUSE^VALM1 I 'Y Q
W !,"Sources displayed on the screen if they apply to the Buffer entry:"
W !," I - Interview"
W !," D - Data Match"
W !," V - IVM"
W !," P - Pre-Registration"
W !," E - eIV"
W !," H - HMS"
W !," M - Medicare"
W !," R - ICB Card Reader"
W !," C - Contract Services"
W !," X - e-Pharmacy" ; IB*2*435
; IB*2*595/DM K,T,U,B,O,N,S,A,J added
W !," K - Kiosk"
W !," F - Interfacility Insurance Update" ; IB*2*528
W !," T - Insurance Import"
; IB*2.0*631/VD - Changed U from Purchased Care Choice to Community Care Network
W !," U - Community Care Network"
W !," B - Purchased Care Fee-Basis"
W !," O - Purchased Care Other"
W !," N - Insurance Intake"
W !," S - Insurance Verification"
W !," A - Veteran Appt Request"
W !," J - MYVA Health Journal"
;/vd - IB*2*664 - Added "W" for Electronic Health Record
W !," W - Electronic Health Record"
W !," G - Adv Med Cost Mgmt Solution" ;IB*668/DW Added
D PAUSE^VALM1 I 'Y Q
;
I VIEW'=5 D ; IB*2*435
. W !,"eIV Electronic Insurance Verification Status"
. W !!,"The following eIV Status indicators may appear to the left of the patient name:",!
. Q
;
I VIEW=1 D
.W !," + - eIV payer response indicates this is an active policy."
.W !," $ - Escalated active policy."
.; W !," * - Previously an active policy." ; IB*2.0*737 removed
.Q
I VIEW=2 D
.W !," - - eIV payer response indicates this is NOT an active policy."
.; W !," * - Previously an not active policy." ; IB*2.0*737 removed
.Q
I $F(",3,6,7,",VIEW) D ;528/baa
.W !," + - eIV payer response indicates this is an active policy."
.W !," ? - Awaiting electronic reply from eIV Payer."
.W !," $ - Escalated Active policy."
.; W !," * - Previously either an active or not active policy." ; IB*2.0*737 removed
.W !," # - Can not determine from eIV response if coverage is Active."
.W !," Review Response Report. Manual verification required."
.W !," ! - eIV was unable to send an inquiry for this entry."
.W !," Corrections required or payer not Active."
.W !," - - eIV payer response indicates this is NOT an active policy."
.W !," % - CMS responded with the patient's new MBI value."
.W !,"<Blank> - Entry added through manual process."
.Q
I VIEW=4 D
.W !," ! - eIV was unable to send an inquiry for this entry."
.W !," Corrections required or payer not Active."
.Q
;
I VIEW=5 D ; IB*2*435
. W !," e-Pharmacy buffer entries are not applicable for e-IV processing."
. Q
;
D PAUSE^VALM1 I 'Y Q
W !,"When an entry is Processed it is either:"
W !," Accepted - the Buffer entry's data is stored in the main Insurance files."
W !," - the modified Insurance entry is flagged as Verified."
W !
W !," Rejected - the Buffer entry's data is not stored in the main Insurance files."
W !!
W !,"Once an entry is processed (either accepted or rejected) most of the data in"
W !,"the Buffer File entry is deleted leaving only a stub entry for tracking"
W !,"and reporting purposes."
W !!
W !,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry."
D PAUSE^VALM1
Q
;
EXIT ; exit list manager option and clean up
K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS"),^TMP($J,"SDAMA301"),^TMP($J,"IBCNAPPTS")
K IBCNSORT,IBCNSCRN,DFN,IBINSDA,IBFASTXT,IBBUFDA
D CLEAR^VALM1
Q
;
BLD ; build screen display
N IBCNT,IBCNS1,IBCNS2,IBBUFDA,IBLINE
;
D SORT S IBCNT=0,VALMCNT=0,IBBUFDA=0
;
I '$D(ZTQUEUED) W !,"Building display " ;IB*794/DJW telling users what we are doing
S IBCNS1="" F S IBCNS1=$O(^TMP($J,"IBCNBLLS",IBCNS1)) Q:IBCNS1="" D
.S IBCNS2="" F S IBCNS2=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2)) Q:IBCNS2="" D
..S IBBUFDA=0 F S IBBUFDA=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA)) Q:'IBBUFDA D
...S DFLG=^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA)
...S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#100) W "." ;IB*794/DJW changed '(IBCNT#15) to be #100
...S IBLINE=$$BLDLN(IBBUFDA,IBCNT,DFLG) I IBLINE="" S IBCNT=IBCNT-1 Q ; IB*2*506/taz If line is null stop processing this entry.
...D SET(IBLINE,IBCNT)
;
I VALMCNT=0 D SET("",0),SET("There are no Buffer entries that have not been processed.",0)
Q
;
BLDLN(IBBUFDA,IBCNT,DFLG) ; build line to display on List screen for one Buffer entry
N DFN,IB0,IB20,IB40,IB60,IBLINE,IBMTS,IBY,MCFLAG,VA,VADM,VAERR,VAIN,X,Y
S IBLINE="",IBBUFDA=+$G(IBBUFDA)
S IB40=$G(^IBA(355.33,IBBUFDA,40)),MCFLAG=$$GTMFLG(IBBUFDA) ;IB*2.0*549
S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB60=$G(^IBA(355.33,IBBUFDA,60))
S DFN=+IB60 I +DFN D DEM^VADPT,INP^VADPT
;
;IB*2.0*549 - Replaced the following line of code:
;I 'IBKEYS,'$$ACTIVE(DFN) G BLDLNQ ;IB*2*506/taz Only allow active insurance for users not holding IB INSURANCE EDIT or IB GROUP/PLAN EDIT keys
; With the following code that will determine if the list item is Medicare (+MCFLAG,) then include it on
; the list even if the user doesn't have the security keys and if the patient has ACTIVE or INACTIVE policies.
I 'IBKEYS,'$$ACTIVE(DFN),'MCFLAG G BLDLNQ ;IB*2.0*549
;
S IBY=$G(IBCNT),IBLINE=$$SETSTR^VALM1(IBY,"",1,4)
;
; ESG - 6/6/02 - SDD 5.1.8
; pull the symbol from the symbol function
;
S IBY=$$SYMBOL(IBBUFDA)
;I IBY="*" S IBY=" " ;528/baa ;IB*737/DTG stop '*' verified
S IBY=IBY_$P($G(^DPT(+DFN,0)),U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,5,20)
S IBLINE=$$SETSTR^VALM1(DFLG,IBLINE,25,1)
S IBY=$G(VA("BID")),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,27,4)
S IBY=$P(IB20,U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,32,17)
S IBY=$P(IB60,U,4),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,50,13)
S IBY=$$GET1^DIQ(355.12,$P(IB0,U,3),.03),IBLINE=$$SETSTR^VALM1($$SRCCNV(IBY),IBLINE,64,1)
S IBY=$$DATE(+IB0),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,66,8)
;IB*771/TAZ - Moved Flags logic to FLAGS subroutine.
S IBY="" D FLAGS(DFN,.IBY) S IBLINE=$$SETSTR^VALM1(IBY,IBLINE,76,5)
BLDLNQ ; IB*2*506/taz Tag added
Q IBLINE
;
FLAGS(DFN,IBY) ;Build flag set for line
;IB*771/TAZ - Segregated so that the code could be called from other routines.
;INPUT:
; DFN - Patient IEN
; IBY - String to append the buffer flags to. Must be initialized in calling routine.
;
;
;OUTPUT:
; IBY - String with formatted flags appended.
;
N IBMTS,VA,VADM,VAIN,VAERR
D DEM^VADPT,INP^VADPT
S IBY=IBY_$S(+$$INSURED^IBCNS1(DFN,DT):"i",1:" ")
S IBY=IBY_$S(+$G(VAIN(1)):"I",1:" ")
S IBY=IBY_$S(+$G(VADM(6)):"E",1:" ")
S IBMTS=$P($$LST^DGMTU(DFN),U,4)
S IBY=IBY_$S(IBMTS="C":"Y",IBMTS="G":"Y",1:" ")
S IBY=IBY_$S(+$$HOLD(DFN):"H",1:" ")
Q
;
SET(LINE,CNT) ; set up list manager screen display array
S VALMCNT=VALMCNT+1
S ^TMP("IBCNBLL",$J,VALMCNT,0)=LINE Q:'CNT
S ^TMP("IBCNBLL",$J,"IDX",VALMCNT,+CNT)=""
S ^TMP("IBCNBLLX",$J,CNT)=VALMCNT_U_IBBUFDA
S ^TMP("IBCNBLLY",$J,IBBUFDA)=VALMCNT_U_+CNT
Q
;
SORT ; set up sort for list screen
; IB*2.0*737/DTG remove "8^Verified" reference
; Line below is the relationship between the sort order and the external description.
; 1^Patient Name, 2^Ins Name, 3^Source Of Info, 4^Date Entered, 5^Inpatient (Y/N), 6^Means Test (Y/N), 7^On Hold, 8^Verified, 9^eIV Status, 10^Positive Response
; 1^Patient Name, 2^Ins Name, 3^Source Of Info, 4^Date Entered, 5^Inpatient (Y/N), 6^Means Test (Y/N), 7^On Hold, 8^eIV Status, 10^Positive Response
N APPTNUM,IB0,IB20,IB60,IBCNDT,IBBUFDA,IBCNDFN,IBCNPAT,IBCSORT1,IBCSORT2,IBSDA,DFN,VAIN,VA,VAERR,IBX,IBCNT,INAME,SYM,X,Y
S IBCNT=0
;
K ^TMP($J,"IBCNBLLS") I '$G(IBCNSORT) S IBCNSORT="1^Patient Name"
; get payer ien for Medicare WNR
;
I '$D(ZTQUEUED) W !,"Gathering and sorting the records " ;IB*794/DJW telling users what we are doing
S IBCNDT=0 F S IBCNDT=$O(^IBA(355.33,"AEST","E",IBCNDT)) Q:'IBCNDT D
.S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA)) Q:'IBBUFDA D
..S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#100) W "." ;IB*794/DJW changed '(IBCNT#15) to be #100
..S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB60=$G(^IBA(355.33,IBBUFDA,60))
..S IBCNDFN=+IB60,IBCNPAT="" I +IBCNDFN S IBCNPAT=$P($G(^DPT(IBCNDFN,0)),U,1)
..S INAME=$P(IB20,U)
..;
..I +IBCNSORT=1 S IBCSORT1=IBCNPAT
..I +IBCNSORT=2 S IBCSORT1=INAME
..I +IBCNSORT=3 S IBCSORT1=$P(IB0,U,3)
..I +IBCNSORT=4 S IBCSORT1=$P(+IB0,".",1)
..I +IBCNSORT=5 I +IBCNDFN S DFN=+IBCNDFN D INP^VADPT S IBCSORT1=$S($G(VAIN(1)):1,1:2)
..I +IBCNSORT=6 I +IBCNDFN S IBX=$P($$LST^DGMTU(IBCNDFN),U,4) S IBCSORT1=$S(IBX="C":1,IBX="G":1,1:2)
..I +IBCNSORT=7 I +IBCNDFN S IBX=$$HOLD(IBCNDFN) S IBCSORT1=$S(+IBX:1,1:2)
.. ;IB*737 dropped "* verified" sort which was +IBCNSORT=8, changed
.. ; code below where +IBCNSORT=9 & +IBCNSORT=10 is now 8 and 9
.. ; to compensate for dropping "*"
..; I +IBCNSORT=8 S IBCSORT1=$S(+$P(IB0,U,10):1,1:2) ; IB*737 removed
..; Sort by symbol and then within the symbol, sort by date entered
..; Build a numerical subscript with format ##.FM date
..S SYM=$$SYMBOL(IBBUFDA)
..; I +IBCNSORT=9 S IBCSORT1=$G(IBCNSORT(1,SYM))_"."_$P(+IB0,".",1),IBCSORT1=+IBCSORT1 ;IB*737
..; I +IBCNSORT=10 S IBCSORT1=$S(SYM="+":0,1:1),IBCSORT2=IBCNPAT ;IB*737
..;
..I +IBCNSORT=8 S IBCSORT1=$G(IBCNSORT(1,SYM))_"."_$P(+IB0,".",1),IBCSORT1=+IBCSORT1 ;IB*737
..;
..I +IBCNSORT=9 S IBCSORT1=$S(SYM="+":0,1:1),IBCSORT2=IBCNPAT ;IB*737
..;
..S IBCSORT1=$S($G(IBCSORT1)="":"~UNKNOWN",1:IBCSORT1),IBCSORT2=$S(IBCNPAT="":"~UNKNOWN",1:IBCNPAT)
..; get future appointments
..S IBSDA(1)=DT,IBSDA(3)="R;I;NT",IBSDA(4)=IBCNDFN,IBSDA("FLDS")="1;2"
..S DFLG="" ;,APPTNUM=$$SDAPI^SDAMA301(.IBSDA) I APPTNUM>0,SYM="!" S DFLG="d" ; duplicate flag ;IB*2*506 appointment data removed.
..I $$INCL(VIEW,SYM,IB0) S ^TMP($J,"IBCNBLLS",IBCSORT1,IBCSORT2,IBBUFDA)=DFLG
..K VAIN,IBCSORT1,IBCSORT2
..Q
.Q
;I IBCNT,'$D(ZTQUEUED) W "|" ;IB*794 "|" No longer needed
Q
;
INCL(VIEW,SYM,IB0) ;
N INCL,IENS,IBEBI,MCFLAG
S INCL=0
; IB*2*549 - Added 'MCFLAG to allow Medicare in the following line.
S MCFLAG=$$GTMFLG(IBBUFDA)
I 'IBKEYS,'MCFLAG,(SYM'="+") G INCLQ ; If users don't have required keys, they only see current Positive Entries.
I VIEW=6 S INCL=1 G INCLQ ;Include Everything (Complete view)
I VIEW=7,((INAME["TRICARE")!(INAME["CHAMPVA")) S INCL=1 G INCLQ ; Tricare/Champva;528/baa
I VIEW=5,$P(IB0,U,17) S INCL=1 G INCLQ ;Only e-Pharmacy on e-Pharmacy view (IB*2*435)
I $P(IB0,U,17) G INCLQ ;Exclude e-Pharmacy (IB*2*435)
I VIEW=3,MCFLAG S INCL=1 G INCLQ ;Only Medicare View
I MCFLAG G INCLQ ;Exclude Medicare from Positive, Negative and Failure Views
I VIEW=4,(SYM="!") S INCL=1 G INCLQ ;Only failures on Failure view
I VIEW=1,((SYM="+")!(SYM="$")) S INCL=1 G INCLQ ;Positive View
I VIEW=2,(SYM="-") S INCL=1 G INCLQ ;Negative View
;I SYM="*" D G INCLQ ;IB*737/DTG stop '*' verified
;. ;find history in Response file for verified entries.
;. I $$GET1^DIQ(355.33,IBBUFDA,.15)="" S:(VIEW=1) INCL=1 Q ;IIV PROCESSED DATE field is empty entry is positive
;. S IENS="1,"_$O(^IBCN(365,"AF",IBBUFDA,""))_","
;. ;the following line of code is necessary to check for both "eIV Eligibility Determination" and "IIV Eligibility Determination" (IB*2.0*506)
;. I $$GET1^DIQ(365.02,IENS,.06)["IV Eligibility Determination" Q
;. S IBEBI=$$GET1^DIQ(365.02,IENS,.02) ;Eligibility/Benefits Info
;. I IBEBI=1 S:(VIEW=1) INCL=1 Q
;. I VIEW=2 S INCL=1 Q
INCLQ ;
Q INCL
;
DATE(X) ;
Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
HOLD(DFN) ; returns true if patient has bills On Hold
Q $D(^IB("AH",+$G(DFN)))
;
SYMBOL(IBBUFDA) ; Returns the symbol for this buffer entry
NEW IB0,SYM
S IB0=$G(^IBA(355.33,IBBUFDA,0)),SYM=""
I +$P(IB0,U,12) S SYM=$C($P($G(^IBE(365.15,+$P(IB0,U,12),0)),U,2))
; If the entry has been manually verified, override the symbol displayed
;I $P(IB0,U,10)'="",'+$P(IB0,U,12) S SYM="*" ;IB*737/DTG stop '*' verified
I SYM="" S SYM=" "
Q SYM
;
;
UPDLN(IBBUFDA,ACTION) ; *** called by any action that modifies a buffer entry, so list screen can be updated if screen not recompiled
; modifies a single line in the display array for a buffer entry that has been modified in some way
; ACTION = REJECTED, ACCEPTED, EDITED
N IBARRN,IBOLD,IBNEW,IBO,IBN S IBO="0123456789",IBN="----------"
;
S IBARRN=$G(^TMP("IBCNBLLY",$J,+$G(IBBUFDA))) Q:'IBARRN
S IBOLD=$G(^TMP("IBCNBLL",$J,+IBARRN,0)) Q:IBOLD=""
;
; if action is REJECTED or ACCEPTED then the patient name is replaced by the Action in the display array
; and the buffer entry is removed from the list of entries that can be selected
I (ACTION="REJECTED")!(ACTION="ACCEPTED") D
. S IBNEW=$TR($E(IBOLD,1,5),IBO,IBN)_ACTION_$J("",7)_$E(IBOLD,21,999)
. S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW
;
; if the action is EDITED then the line for the buffer entry is recompiled and the updated line is set into
; the display array
I ACTION="EDITED" D
. S IBNEW=$$BLDLN(IBBUFDA,+$P(IBARRN,U,2),$E(IBOLD,25))
. S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW
Q
;
SRCCNV(SRC) ; convert Source of Info acronym from field 355.12/.03 into 1 char code
; IB*2*595/DM T,U,B,O,N,S,A,K,J translations added
; IB*2*664/DW updated "U" for Community Care Network - should be CCN and not PCC
; IB*2*664/VD added "W" for Electronic Health Record
; IB*2*668/DW added "G" for Adv Med Cost Mgmt Solution
N SRCSTR,CODE
Q:SRC="" ""
S SRCSTR="INTVW;I^DMTCH;D^IVM;V^PreRg;P^eIV;E^HMS;H^MCR;M^ICB;R^CS;C^eRxEL;X^IIU;F^INSPT;T^CCN;U^PCFB;B^PCOTR;O^INSIN;N^INSVR;S^VAR;A^KSK;K^MVAH;J^EHR;W^AMCMS;G"
S CODE=$P($P(SRCSTR,SRC_";",2),U,1)
Q CODE
;
GETKEYS(DUZ) ;
;Make sure that user has the INSURANCE EDIT key and/or the GROUP/PLAN EDIT key. User
;must have either key in order to see non_Positive Entries.
N KEY1,KEY2
S KEY1=$O(^DIC(19.1,"B","IB INSURANCE COMPANY EDIT","")) I KEY1 S KEY1=$D(^VA(200,DUZ,51,KEY1))
S KEY2=$O(^DIC(19.1,"B","IB GROUP PLAN EDIT","")) I KEY2 S KEY2=$D(^VA(200,DUZ,51,KEY2))
Q KEY1!KEY2
;
ACTIVE(DFN) ;Check for active insurance
N IBINSCO
D ALL^IBCNS1(DFN,"IBINSCO",3,DT,0) ;IB*2.0*519 allow WNRs and Indemnity plans
Q +$G(IBINSCO(0))
;
GTMFLG(IBBUFDA) ;Check if Medicare
; IB*2.0*549 Added method
N MWNRIEN,MWNRFLG
S MWNRFLG=0
S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25)
S MWNRFLG=0
I MWNRIEN'="",$P($$INSERROR^IBCNEUT3("B",IBBUFDA),U,2)=MWNRIEN S MWNRFLG=1
Q MWNRFLG
REFRESH ; IB*794/DJW Refresh the buffer data but keep the selected view and sort
D INIT,HDR
S VALMBCK="R",VALMBG=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBLL 18114 printed Dec 13, 2024@02:14:06 Page 2
IBCNBLL ;ALB/ARH - Ins Buffer: LM main screen, list buffer entries ;1 Jun 97
+1 ;;2.0;INTEGRATED BILLING;**82,149,153,183,184,271,345,416,438,435,506,519,528,549,601,595,631,664,668,737,771,794**;21-MAR-94;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; DBIA# 642 for call to $$LST^DGMTU
+5 ; DBIA# 4433 for call to $$SDAPI^SDAMA301
+6 ;
EN ; - main entry point for screen
+1 NEW VIEW,AVIEW,DFLG,IBKEYS
+2 ; default to complete view ;IB*2*506/taz changed
SET VIEW=6
SET AVIEW=0
+3 ; clear temp. global for eIV real time inquiries
KILL ^TMP("IBCNERTQ",$JOB)
+4 DO EN^VALM("IBCNB INSURANCE BUFFER LIST")
+5 QUIT
+6 ;
EN1(V) ; entry point from view changing actions
+1 SET VIEW=V
SET AVIEW=$SELECT(VIEW=4:1,1:0)
+2 DO INIT
DO HDR
+3 SET VALMBCK="R"
SET VALMBG=1
+4 QUIT
+5 ;
HDR ; header code for list manager display
+1 SET VALMHDR(1)="Sorted by: "_$PIECE(IBCNSORT,U,2)
+2 IF $PIECE(IBCNSORT,U,3)'=""
SET VALMHDR(1)=VALMHDR(1)_", """_$PIECE(IBCNSORT,U,3)_""" first"
+3 ; IB*2.0*737/DTG remove '* verified' reference from VALMSG,
+4 ; impacts views 1-3 and 5
+5 ; I VIEW=1 S VALM("TITLE")="Positive Insurance Buffer",VALMSG="*Verified +Active" ;IB*2*506/taz Only shows Verified and Active records.
+6 ; I VIEW=2 S VALM("TITLE")="Negative Insurance Buffer",VALMSG="*Verified -N/Active" ;IB*2*506/taz Only shows Verified and N/Active records.
+7 ; I VIEW=3 S VALM("TITLE")="Medicare(WNR) Insurance Buffer",VALMSG="*Verified +Act -N/Act ?Await/R #Unclr !Unable/Send"
+8 ; I VIEW=5 S VALM("TITLE")="e-Pharmacy Buffer",VALMSG="*Verified" ; IB*2*435
+9 ;IB*2*506/taz & IB*737 Active policies only
IF VIEW=1
SET VALM("TITLE")="Positive Insurance Buffer"
SET VALMSG="+Active"
+10 ;IB*2*506/taz & IB*737 Inactive policies only
IF VIEW=2
SET VALM("TITLE")="Negative Insurance Buffer"
SET VALMSG="-N/Active"
+11 ; IB737 removed *Verified
IF VIEW=3
SET VALM("TITLE")="Medicare(WNR) Insurance Buffer"
SET VALMSG="+Act -N/Act ?Await/R #Unclr !Unable/Send"
+12 ;IB*2*506/taz changed
IF VIEW=4
SET VALM("TITLE")="Failure Buffer"
SET VALMSG="!Unable/Send"
+13 ; IB*2*435 & IB*737 dropped "*Verified"
IF VIEW=5
SET VALM("TITLE")="e-Pharmacy Buffer"
SET VALMSG=""
+14 ; IB*2*506/taz added
IF VIEW=6
SET VALM("TITLE")="Complete Buffer"
SET VALMSG=""
+15 ;528/baa added
IF VIEW=7
SET VALM("TITLE")="TRICARE/CHAMPVA"
SET VALMSG=""
+16 QUIT
+17 ;
INIT ; initialization for list manager list
+1 KILL ^TMP("IBCNBLL",$JOB),^TMP("IBCNBLLX",$JOB),^TMP("IBCNBLLY",$JOB),^TMP($JOB,"IBCNBLLS"),^TMP($JOB,"IBCNAPPTS")
+2 ; IB*2.0*737/DTG correct IBCNSORT due to removed "*"
+3 ; S:$G(IBCNSORT)="" IBCNSORT=$S(VIEW=1:"10^Positive Response",1:"1^Patient Name")
+4 ;IB*794/DTG if sort is null default to patient name for all
+5 ;S:$G(IBCNSORT)="" IBCNSORT=$S(VIEW=1:"9^Positive Response",1:"1^Patient Name")
+6 if $GET(IBCNSORT)=""
SET IBCNSORT="1^Patient Name"
+7 ;IB*2*506/taz user must have either IB INSURANCE EDIT or IB GROUP/PLAN EDIT in order to view entries without defined insurance company entries
SET IBKEYS=$$GETKEYS(DUZ)
+8 DO BLD
+9 QUIT
+10 ;
HELP ; list manager help
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 WRITE @IOF
+4 WRITE !,"Flags displayed on screen if they apply to the Buffer entry:"
+5 WRITE !," i - Patient has other currently effective Insurance"
+6 WRITE !," I - Patient is currently admitted as an Inpatient"
+7 WRITE !," E - Patient has Expired"
+8 WRITE !," Y - Means Test Copay Patient"
+9 WRITE !," H - Patient has Bills On Hold"
+10 ; W !," * - Buffer entry Verified by User" ; IB*2.0*737 removed
+11 WRITE !
+12 DO PAUSE^VALM1
IF 'Y
QUIT
+13 WRITE !,"Sources displayed on the screen if they apply to the Buffer entry:"
+14 WRITE !," I - Interview"
+15 WRITE !," D - Data Match"
+16 WRITE !," V - IVM"
+17 WRITE !," P - Pre-Registration"
+18 WRITE !," E - eIV"
+19 WRITE !," H - HMS"
+20 WRITE !," M - Medicare"
+21 WRITE !," R - ICB Card Reader"
+22 WRITE !," C - Contract Services"
+23 ; IB*2*435
WRITE !," X - e-Pharmacy"
+24 ; IB*2*595/DM K,T,U,B,O,N,S,A,J added
+25 WRITE !," K - Kiosk"
+26 ; IB*2*528
WRITE !," F - Interfacility Insurance Update"
+27 WRITE !," T - Insurance Import"
+28 ; IB*2.0*631/VD - Changed U from Purchased Care Choice to Community Care Network
+29 WRITE !," U - Community Care Network"
+30 WRITE !," B - Purchased Care Fee-Basis"
+31 WRITE !," O - Purchased Care Other"
+32 WRITE !," N - Insurance Intake"
+33 WRITE !," S - Insurance Verification"
+34 WRITE !," A - Veteran Appt Request"
+35 WRITE !," J - MYVA Health Journal"
+36 ;/vd - IB*2*664 - Added "W" for Electronic Health Record
+37 WRITE !," W - Electronic Health Record"
+38 ;IB*668/DW Added
WRITE !," G - Adv Med Cost Mgmt Solution"
+39 DO PAUSE^VALM1
IF 'Y
QUIT
+40 ;
+41 ; IB*2*435
IF VIEW'=5
Begin DoDot:1
+42 WRITE !,"eIV Electronic Insurance Verification Status"
+43 WRITE !!,"The following eIV Status indicators may appear to the left of the patient name:",!
+44 QUIT
End DoDot:1
+45 ;
+46 IF VIEW=1
Begin DoDot:1
+47 WRITE !," + - eIV payer response indicates this is an active policy."
+48 WRITE !," $ - Escalated active policy."
+49 ; W !," * - Previously an active policy." ; IB*2.0*737 removed
+50 QUIT
End DoDot:1
+51 IF VIEW=2
Begin DoDot:1
+52 WRITE !," - - eIV payer response indicates this is NOT an active policy."
+53 ; W !," * - Previously an not active policy." ; IB*2.0*737 removed
+54 QUIT
End DoDot:1
+55 ;528/baa
IF $FIND(",3,6,7,",VIEW)
Begin DoDot:1
+56 WRITE !," + - eIV payer response indicates this is an active policy."
+57 WRITE !," ? - Awaiting electronic reply from eIV Payer."
+58 WRITE !," $ - Escalated Active policy."
+59 ; W !," * - Previously either an active or not active policy." ; IB*2.0*737 removed
+60 WRITE !," # - Can not determine from eIV response if coverage is Active."
+61 WRITE !," Review Response Report. Manual verification required."
+62 WRITE !," ! - eIV was unable to send an inquiry for this entry."
+63 WRITE !," Corrections required or payer not Active."
+64 WRITE !," - - eIV payer response indicates this is NOT an active policy."
+65 WRITE !," % - CMS responded with the patient's new MBI value."
+66 WRITE !,"<Blank> - Entry added through manual process."
+67 QUIT
End DoDot:1
+68 IF VIEW=4
Begin DoDot:1
+69 WRITE !," ! - eIV was unable to send an inquiry for this entry."
+70 WRITE !," Corrections required or payer not Active."
+71 QUIT
End DoDot:1
+72 ;
+73 ; IB*2*435
IF VIEW=5
Begin DoDot:1
+74 WRITE !," e-Pharmacy buffer entries are not applicable for e-IV processing."
+75 QUIT
End DoDot:1
+76 ;
+77 DO PAUSE^VALM1
IF 'Y
QUIT
+78 WRITE !,"When an entry is Processed it is either:"
+79 WRITE !," Accepted - the Buffer entry's data is stored in the main Insurance files."
+80 WRITE !," - the modified Insurance entry is flagged as Verified."
+81 WRITE !
+82 WRITE !," Rejected - the Buffer entry's data is not stored in the main Insurance files."
+83 WRITE !!
+84 WRITE !,"Once an entry is processed (either accepted or rejected) most of the data in"
+85 WRITE !,"the Buffer File entry is deleted leaving only a stub entry for tracking"
+86 WRITE !,"and reporting purposes."
+87 WRITE !!
+88 WRITE !,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry."
+89 DO PAUSE^VALM1
+90 QUIT
+91 ;
EXIT ; exit list manager option and clean up
+1 KILL ^TMP("IBCNBLL",$JOB),^TMP("IBCNBLLX",$JOB),^TMP("IBCNBLLY",$JOB),^TMP($JOB,"IBCNBLLS"),^TMP($JOB,"SDAMA301"),^TMP($JOB,"IBCNAPPTS")
+2 KILL IBCNSORT,IBCNSCRN,DFN,IBINSDA,IBFASTXT,IBBUFDA
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
BLD ; build screen display
+1 NEW IBCNT,IBCNS1,IBCNS2,IBBUFDA,IBLINE
+2 ;
+3 DO SORT
SET IBCNT=0
SET VALMCNT=0
SET IBBUFDA=0
+4 ;
+5 ;IB*794/DJW telling users what we are doing
IF '$DATA(ZTQUEUED)
WRITE !,"Building display "
+6 SET IBCNS1=""
FOR
SET IBCNS1=$ORDER(^TMP($JOB,"IBCNBLLS",IBCNS1))
if IBCNS1=""
QUIT
Begin DoDot:1
+7 SET IBCNS2=""
FOR
SET IBCNS2=$ORDER(^TMP($JOB,"IBCNBLLS",IBCNS1,IBCNS2))
if IBCNS2=""
QUIT
Begin DoDot:2
+8 SET IBBUFDA=0
FOR
SET IBBUFDA=$ORDER(^TMP($JOB,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA))
if 'IBBUFDA
QUIT
Begin DoDot:3
+9 SET DFLG=^TMP($JOB,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA)
+10 ;IB*794/DJW changed '(IBCNT#15) to be #100
SET IBCNT=IBCNT+1
IF '$DATA(ZTQUEUED)
IF '(IBCNT#100)
WRITE "."
+11 ; IB*2*506/taz If line is null stop processing this entry.
SET IBLINE=$$BLDLN(IBBUFDA,IBCNT,DFLG)
IF IBLINE=""
SET IBCNT=IBCNT-1
QUIT
+12 DO SET(IBLINE,IBCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 IF VALMCNT=0
DO SET("",0)
DO SET("There are no Buffer entries that have not been processed.",0)
+15 QUIT
+16 ;
BLDLN(IBBUFDA,IBCNT,DFLG) ; build line to display on List screen for one Buffer entry
+1 NEW DFN,IB0,IB20,IB40,IB60,IBLINE,IBMTS,IBY,MCFLAG,VA,VADM,VAERR,VAIN,X,Y
+2 SET IBLINE=""
SET IBBUFDA=+$GET(IBBUFDA)
+3 ;IB*2.0*549
SET IB40=$GET(^IBA(355.33,IBBUFDA,40))
SET MCFLAG=$$GTMFLG(IBBUFDA)
+4 SET IB0=$GET(^IBA(355.33,IBBUFDA,0))
SET IB20=$GET(^IBA(355.33,IBBUFDA,20))
SET IB60=$GET(^IBA(355.33,IBBUFDA,60))
+5 SET DFN=+IB60
IF +DFN
DO DEM^VADPT
DO INP^VADPT
+6 ;
+7 ;IB*2.0*549 - Replaced the following line of code:
+8 ;I 'IBKEYS,'$$ACTIVE(DFN) G BLDLNQ ;IB*2*506/taz Only allow active insurance for users not holding IB INSURANCE EDIT or IB GROUP/PLAN EDIT keys
+9 ; With the following code that will determine if the list item is Medicare (+MCFLAG,) then include it on
+10 ; the list even if the user doesn't have the security keys and if the patient has ACTIVE or INACTIVE policies.
+11 ;IB*2.0*549
IF 'IBKEYS
IF '$$ACTIVE(DFN)
IF 'MCFLAG
GOTO BLDLNQ
+12 ;
+13 SET IBY=$GET(IBCNT)
SET IBLINE=$$SETSTR^VALM1(IBY,"",1,4)
+14 ;
+15 ; ESG - 6/6/02 - SDD 5.1.8
+16 ; pull the symbol from the symbol function
+17 ;
+18 SET IBY=$$SYMBOL(IBBUFDA)
+19 ;I IBY="*" S IBY=" " ;528/baa ;IB*737/DTG stop '*' verified
+20 SET IBY=IBY_$PIECE($GET(^DPT(+DFN,0)),U,1)
SET IBLINE=$$SETSTR^VALM1(IBY,IBLINE,5,20)
+21 SET IBLINE=$$SETSTR^VALM1(DFLG,IBLINE,25,1)
+22 SET IBY=$GET(VA("BID"))
SET IBLINE=$$SETSTR^VALM1(IBY,IBLINE,27,4)
+23 SET IBY=$PIECE(IB20,U,1)
SET IBLINE=$$SETSTR^VALM1(IBY,IBLINE,32,17)
+24 SET IBY=$PIECE(IB60,U,4)
SET IBLINE=$$SETSTR^VALM1(IBY,IBLINE,50,13)
+25 SET IBY=$$GET1^DIQ(355.12,$PIECE(IB0,U,3),.03)
SET IBLINE=$$SETSTR^VALM1($$SRCCNV(IBY),IBLINE,64,1)
+26 SET IBY=$$DATE(+IB0)
SET IBLINE=$$SETSTR^VALM1(IBY,IBLINE,66,8)
+27 ;IB*771/TAZ - Moved Flags logic to FLAGS subroutine.
+28 SET IBY=""
DO FLAGS(DFN,.IBY)
SET IBLINE=$$SETSTR^VALM1(IBY,IBLINE,76,5)
BLDLNQ ; IB*2*506/taz Tag added
+1 QUIT IBLINE
+2 ;
FLAGS(DFN,IBY) ;Build flag set for line
+1 ;IB*771/TAZ - Segregated so that the code could be called from other routines.
+2 ;INPUT:
+3 ; DFN - Patient IEN
+4 ; IBY - String to append the buffer flags to. Must be initialized in calling routine.
+5 ;
+6 ;
+7 ;OUTPUT:
+8 ; IBY - String with formatted flags appended.
+9 ;
+10 NEW IBMTS,VA,VADM,VAIN,VAERR
+11 DO DEM^VADPT
DO INP^VADPT
+12 SET IBY=IBY_$SELECT(+$$INSURED^IBCNS1(DFN,DT):"i",1:" ")
+13 SET IBY=IBY_$SELECT(+$GET(VAIN(1)):"I",1:" ")
+14 SET IBY=IBY_$SELECT(+$GET(VADM(6)):"E",1:" ")
+15 SET IBMTS=$PIECE($$LST^DGMTU(DFN),U,4)
+16 SET IBY=IBY_$SELECT(IBMTS="C":"Y",IBMTS="G":"Y",1:" ")
+17 SET IBY=IBY_$SELECT(+$$HOLD(DFN):"H",1:" ")
+18 QUIT
+19 ;
SET(LINE,CNT) ; set up list manager screen display array
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCNBLL",$JOB,VALMCNT,0)=LINE
if 'CNT
QUIT
+3 SET ^TMP("IBCNBLL",$JOB,"IDX",VALMCNT,+CNT)=""
+4 SET ^TMP("IBCNBLLX",$JOB,CNT)=VALMCNT_U_IBBUFDA
+5 SET ^TMP("IBCNBLLY",$JOB,IBBUFDA)=VALMCNT_U_+CNT
+6 QUIT
+7 ;
SORT ; set up sort for list screen
+1 ; IB*2.0*737/DTG remove "8^Verified" reference
+2 ; Line below is the relationship between the sort order and the external description.
+3 ; 1^Patient Name, 2^Ins Name, 3^Source Of Info, 4^Date Entered, 5^Inpatient (Y/N), 6^Means Test (Y/N), 7^On Hold, 8^Verified, 9^eIV Status, 10^Positive Response
+4 ; 1^Patient Name, 2^Ins Name, 3^Source Of Info, 4^Date Entered, 5^Inpatient (Y/N), 6^Means Test (Y/N), 7^On Hold, 8^eIV Status, 10^Positive Response
+5 NEW APPTNUM,IB0,IB20,IB60,IBCNDT,IBBUFDA,IBCNDFN,IBCNPAT,IBCSORT1,IBCSORT2,IBSDA,DFN,VAIN,VA,VAERR,IBX,IBCNT,INAME,SYM,X,Y
+6 SET IBCNT=0
+7 ;
+8 KILL ^TMP($JOB,"IBCNBLLS")
IF '$GET(IBCNSORT)
SET IBCNSORT="1^Patient Name"
+9 ; get payer ien for Medicare WNR
+10 ;
+11 ;IB*794/DJW telling users what we are doing
IF '$DATA(ZTQUEUED)
WRITE !,"Gathering and sorting the records "
+12 SET IBCNDT=0
FOR
SET IBCNDT=$ORDER(^IBA(355.33,"AEST","E",IBCNDT))
if 'IBCNDT
QUIT
Begin DoDot:1
+13 SET IBBUFDA=0
FOR
SET IBBUFDA=$ORDER(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA))
if 'IBBUFDA
QUIT
Begin DoDot:2
+14 ;IB*794/DJW changed '(IBCNT#15) to be #100
SET IBCNT=IBCNT+1
IF '$DATA(ZTQUEUED)
IF '(IBCNT#100)
WRITE "."
+15 SET IB0=$GET(^IBA(355.33,IBBUFDA,0))
SET IB20=$GET(^IBA(355.33,IBBUFDA,20))
SET IB60=$GET(^IBA(355.33,IBBUFDA,60))
+16 SET IBCNDFN=+IB60
SET IBCNPAT=""
IF +IBCNDFN
SET IBCNPAT=$PIECE($GET(^DPT(IBCNDFN,0)),U,1)
+17 SET INAME=$PIECE(IB20,U)
+18 ;
+19 IF +IBCNSORT=1
SET IBCSORT1=IBCNPAT
+20 IF +IBCNSORT=2
SET IBCSORT1=INAME
+21 IF +IBCNSORT=3
SET IBCSORT1=$PIECE(IB0,U,3)
+22 IF +IBCNSORT=4
SET IBCSORT1=$PIECE(+IB0,".",1)
+23 IF +IBCNSORT=5
IF +IBCNDFN
SET DFN=+IBCNDFN
DO INP^VADPT
SET IBCSORT1=$SELECT($GET(VAIN(1)):1,1:2)
+24 IF +IBCNSORT=6
IF +IBCNDFN
SET IBX=$PIECE($$LST^DGMTU(IBCNDFN),U,4)
SET IBCSORT1=$SELECT(IBX="C":1,IBX="G":1,1:2)
+25 IF +IBCNSORT=7
IF +IBCNDFN
SET IBX=$$HOLD(IBCNDFN)
SET IBCSORT1=$SELECT(+IBX:1,1:2)
+26 ;IB*737 dropped "* verified" sort which was +IBCNSORT=8, changed
+27 ; code below where +IBCNSORT=9 & +IBCNSORT=10 is now 8 and 9
+28 ; to compensate for dropping "*"
+29 ; I +IBCNSORT=8 S IBCSORT1=$S(+$P(IB0,U,10):1,1:2) ; IB*737 removed
+30 ; Sort by symbol and then within the symbol, sort by date entered
+31 ; Build a numerical subscript with format ##.FM date
+32 SET SYM=$$SYMBOL(IBBUFDA)
+33 ; I +IBCNSORT=9 S IBCSORT1=$G(IBCNSORT(1,SYM))_"."_$P(+IB0,".",1),IBCSORT1=+IBCSORT1 ;IB*737
+34 ; I +IBCNSORT=10 S IBCSORT1=$S(SYM="+":0,1:1),IBCSORT2=IBCNPAT ;IB*737
+35 ;
+36 ;IB*737
IF +IBCNSORT=8
SET IBCSORT1=$GET(IBCNSORT(1,SYM))_"."_$PIECE(+IB0,".",1)
SET IBCSORT1=+IBCSORT1
+37 ;
+38 ;IB*737
IF +IBCNSORT=9
SET IBCSORT1=$SELECT(SYM="+":0,1:1)
SET IBCSORT2=IBCNPAT
+39 ;
+40 SET IBCSORT1=$SELECT($GET(IBCSORT1)="":"~UNKNOWN",1:IBCSORT1)
SET IBCSORT2=$SELECT(IBCNPAT="":"~UNKNOWN",1:IBCNPAT)
+41 ; get future appointments
+42 SET IBSDA(1)=DT
SET IBSDA(3)="R;I;NT"
SET IBSDA(4)=IBCNDFN
SET IBSDA("FLDS")="1;2"
+43 ;,APPTNUM=$$SDAPI^SDAMA301(.IBSDA) I APPTNUM>0,SYM="!" S DFLG="d" ; duplicate flag ;IB*2*506 appointment data removed.
SET DFLG=""
+44 IF $$INCL(VIEW,SYM,IB0)
SET ^TMP($JOB,"IBCNBLLS",IBCSORT1,IBCSORT2,IBBUFDA)=DFLG
+45 KILL VAIN,IBCSORT1,IBCSORT2
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
+48 ;I IBCNT,'$D(ZTQUEUED) W "|" ;IB*794 "|" No longer needed
+49 QUIT
+50 ;
INCL(VIEW,SYM,IB0) ;
+1 NEW INCL,IENS,IBEBI,MCFLAG
+2 SET INCL=0
+3 ; IB*2*549 - Added 'MCFLAG to allow Medicare in the following line.
+4 SET MCFLAG=$$GTMFLG(IBBUFDA)
+5 ; If users don't have required keys, they only see current Positive Entries.
IF 'IBKEYS
IF 'MCFLAG
IF (SYM'="+")
GOTO INCLQ
+6 ;Include Everything (Complete view)
IF VIEW=6
SET INCL=1
GOTO INCLQ
+7 ; Tricare/Champva;528/baa
IF VIEW=7
IF ((INAME["TRICARE")!(INAME["CHAMPVA"))
SET INCL=1
GOTO INCLQ
+8 ;Only e-Pharmacy on e-Pharmacy view (IB*2*435)
IF VIEW=5
IF $PIECE(IB0,U,17)
SET INCL=1
GOTO INCLQ
+9 ;Exclude e-Pharmacy (IB*2*435)
IF $PIECE(IB0,U,17)
GOTO INCLQ
+10 ;Only Medicare View
IF VIEW=3
IF MCFLAG
SET INCL=1
GOTO INCLQ
+11 ;Exclude Medicare from Positive, Negative and Failure Views
IF MCFLAG
GOTO INCLQ
+12 ;Only failures on Failure view
IF VIEW=4
IF (SYM="!")
SET INCL=1
GOTO INCLQ
+13 ;Positive View
IF VIEW=1
IF ((SYM="+")!(SYM="$"))
SET INCL=1
GOTO INCLQ
+14 ;Negative View
IF VIEW=2
IF (SYM="-")
SET INCL=1
GOTO INCLQ
+15 ;I SYM="*" D G INCLQ ;IB*737/DTG stop '*' verified
+16 ;. ;find history in Response file for verified entries.
+17 ;. I $$GET1^DIQ(355.33,IBBUFDA,.15)="" S:(VIEW=1) INCL=1 Q ;IIV PROCESSED DATE field is empty entry is positive
+18 ;. S IENS="1,"_$O(^IBCN(365,"AF",IBBUFDA,""))_","
+19 ;. ;the following line of code is necessary to check for both "eIV Eligibility Determination" and "IIV Eligibility Determination" (IB*2.0*506)
+20 ;. I $$GET1^DIQ(365.02,IENS,.06)["IV Eligibility Determination" Q
+21 ;. S IBEBI=$$GET1^DIQ(365.02,IENS,.02) ;Eligibility/Benefits Info
+22 ;. I IBEBI=1 S:(VIEW=1) INCL=1 Q
+23 ;. I VIEW=2 S INCL=1 Q
INCLQ ;
+1 QUIT INCL
+2 ;
DATE(X) ;
+1 QUIT $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
HOLD(DFN) ; returns true if patient has bills On Hold
+1 QUIT $DATA(^IB("AH",+$GET(DFN)))
+2 ;
SYMBOL(IBBUFDA) ; Returns the symbol for this buffer entry
+1 NEW IB0,SYM
+2 SET IB0=$GET(^IBA(355.33,IBBUFDA,0))
SET SYM=""
+3 IF +$PIECE(IB0,U,12)
SET SYM=$CHAR($PIECE($GET(^IBE(365.15,+$PIECE(IB0,U,12),0)),U,2))
+4 ; If the entry has been manually verified, override the symbol displayed
+5 ;I $P(IB0,U,10)'="",'+$P(IB0,U,12) S SYM="*" ;IB*737/DTG stop '*' verified
+6 IF SYM=""
SET SYM=" "
+7 QUIT SYM
+8 ;
+9 ;
UPDLN(IBBUFDA,ACTION) ; *** called by any action that modifies a buffer entry, so list screen can be updated if screen not recompiled
+1 ; modifies a single line in the display array for a buffer entry that has been modified in some way
+2 ; ACTION = REJECTED, ACCEPTED, EDITED
+3 NEW IBARRN,IBOLD,IBNEW,IBO,IBN
SET IBO="0123456789"
SET IBN="----------"
+4 ;
+5 SET IBARRN=$GET(^TMP("IBCNBLLY",$JOB,+$GET(IBBUFDA)))
if 'IBARRN
QUIT
+6 SET IBOLD=$GET(^TMP("IBCNBLL",$JOB,+IBARRN,0))
if IBOLD=""
QUIT
+7 ;
+8 ; if action is REJECTED or ACCEPTED then the patient name is replaced by the Action in the display array
+9 ; and the buffer entry is removed from the list of entries that can be selected
+10 IF (ACTION="REJECTED")!(ACTION="ACCEPTED")
Begin DoDot:1
+11 SET IBNEW=$TRANSLATE($EXTRACT(IBOLD,1,5),IBO,IBN)_ACTION_$JUSTIFY("",7)_$EXTRACT(IBOLD,21,999)
+12 SET ^TMP("IBCNBLL",$JOB,+IBARRN,0)=IBNEW
End DoDot:1
+13 ;
+14 ; if the action is EDITED then the line for the buffer entry is recompiled and the updated line is set into
+15 ; the display array
+16 IF ACTION="EDITED"
Begin DoDot:1
+17 SET IBNEW=$$BLDLN(IBBUFDA,+$PIECE(IBARRN,U,2),$EXTRACT(IBOLD,25))
+18 SET ^TMP("IBCNBLL",$JOB,+IBARRN,0)=IBNEW
End DoDot:1
+19 QUIT
+20 ;
SRCCNV(SRC) ; convert Source of Info acronym from field 355.12/.03 into 1 char code
+1 ; IB*2*595/DM T,U,B,O,N,S,A,K,J translations added
+2 ; IB*2*664/DW updated "U" for Community Care Network - should be CCN and not PCC
+3 ; IB*2*664/VD added "W" for Electronic Health Record
+4 ; IB*2*668/DW added "G" for Adv Med Cost Mgmt Solution
+5 NEW SRCSTR,CODE
+6 if SRC=""
QUIT ""
+7 SET SRCSTR="INTVW;I^DMTCH;D^IVM;V^PreRg;P^eIV;E^HMS;H^MCR;M^ICB;R^CS;C^eRxEL;X^IIU;F^INSPT;T^CCN;U^PCFB;B^PCOTR;O^INSIN;N^INSVR;S^VAR;A^KSK;K^MVAH;J^EHR;W^AMCMS;G"
+8 SET CODE=$PIECE($PIECE(SRCSTR,SRC_";",2),U,1)
+9 QUIT CODE
+10 ;
GETKEYS(DUZ) ;
+1 ;Make sure that user has the INSURANCE EDIT key and/or the GROUP/PLAN EDIT key. User
+2 ;must have either key in order to see non_Positive Entries.
+3 NEW KEY1,KEY2
+4 SET KEY1=$ORDER(^DIC(19.1,"B","IB INSURANCE COMPANY EDIT",""))
IF KEY1
SET KEY1=$DATA(^VA(200,DUZ,51,KEY1))
+5 SET KEY2=$ORDER(^DIC(19.1,"B","IB GROUP PLAN EDIT",""))
IF KEY2
SET KEY2=$DATA(^VA(200,DUZ,51,KEY2))
+6 QUIT KEY1!KEY2
+7 ;
ACTIVE(DFN) ;Check for active insurance
+1 NEW IBINSCO
+2 ;IB*2.0*519 allow WNRs and Indemnity plans
DO ALL^IBCNS1(DFN,"IBINSCO",3,DT,0)
+3 QUIT +$GET(IBINSCO(0))
+4 ;
GTMFLG(IBBUFDA) ;Check if Medicare
+1 ; IB*2.0*549 Added method
+2 NEW MWNRIEN,MWNRFLG
+3 SET MWNRFLG=0
+4 SET MWNRIEN=$PIECE($GET(^IBE(350.9,1,51)),U,25)
+5 SET MWNRFLG=0
+6 IF MWNRIEN'=""
IF $PIECE($$INSERROR^IBCNEUT3("B",IBBUFDA),U,2)=MWNRIEN
SET MWNRFLG=1
+7 QUIT MWNRFLG
REFRESH ; IB*794/DJW Refresh the buffer data but keep the selected view and sort
+1 DO INIT
DO HDR
+2 SET VALMBCK="R"
SET VALMBG=1
+3 QUIT
+4 ;
