IBCNS3 ;ALB/ARH - DISPLAY EXTENDED INSURANCE ; 01-DEC-04
;;2.0;INTEGRATED BILLING;**287,399,416,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
DISP(DFN,DATE,DISPLAY) ; Display all insurance company information
; input: DFN = pointer to patient
; DATE = date to check for coverage and riders
; DISPLAY = contain indicators of data to display (1234)
; 1 : first line of display ins company and plan data
; 2 : extended data (Plan Filing Timeframe, Plan Coverage, Conditional Coverage Comments, and Riders)
; 3 : ins. policy comments and plan comments
; 4 : eIV eligibility/benefit information (IB*2*416)
;
Q:'$G(DFN) D:'$D(IOF) HOME^%ZIS
N IBINS,IBPOLFN,IBPOL0,IBPLNFN S DISPLAY=$G(DISPLAY) I '$G(DATE) S DATE=DT
K ^TMP($J,"IBCNS3")
;
D ALL^IBCNS1(DFN,"IBINS",3,DATE)
;
I '$D(IBINS) D SETLN(" "),SETLN("No Insurance Information")
;
S IBPOLFN=0 F S IBPOLFN=$O(IBINS(IBPOLFN)) Q:'IBPOLFN D
. S IBPOL0=IBINS(IBPOLFN,0),IBPLNFN=$P(IBPOL0,U,18)
. S ^TMP($J,"IBCNS3")=IBPOLFN
. ;
. D GETLN(IBPOL0,DATE)
. I DISPLAY[2 D GETEXT(DFN,IBPOLFN,IBPOL0,DATE) ; display extended
. I DISPLAY[3 D GETCOM(IBPLNFN,$G(IBINS(IBPOLFN,1))) ; display extended 3, comments
. I DISPLAY[4 D EB(DFN,IBPOLFN) ; display eIV elig/ben data
. Q
;
S ^TMP($J,"IBCNS3")="" D GETNOTES(DFN) ; display final notes/warning messages
;
D PRINT
;
DISPQ K ^TMP($J,"IBCNS3")
Q
;
PRINT ; display compiled array of patient insurance information in ^TMP($J,"IBCNS3")
N IBSUB,IBCOUNT,IBQUIT,IBLEVEL,IBLNX,IBDASH,IBLINE,IBCNTLN S $P(IBDASH,"-",80)="-" S DISPLAY=+$G(DISPLAY)
;
D HDR S IBSUB="IBCNS3",IBCOUNT=3,IBQUIT=0
;
S IBLEVEL=0 F S IBLEVEL=$O(^TMP($J,IBSUB,IBLEVEL)) Q:'IBLEVEL D Q:IBQUIT
. S IBCNTLN=+$G(^TMP($J,IBSUB,IBLEVEL))+1
. ;
. I IBCOUNT>10,(IBCNTLN+IBCOUNT)>(IOSL-3) S IBQUIT=$$EOP Q:IBQUIT D HDR S IBCOUNT=3
. ;
. S IBLNX=0 F S IBLNX=$O(^TMP($J,IBSUB,IBLEVEL,IBLNX)) Q:'IBLNX D Q:IBQUIT
.. ;
.. S IBLINE=$G(^TMP($J,IBSUB,IBLEVEL,IBLNX))
.. ;
.. W !,IBLINE S IBCOUNT=IBCOUNT+1 I IBCOUNT>(IOSL-3) S IBQUIT=$$EOP Q:IBQUIT W @IOF S IBCOUNT=2
. ;
. I 'IBQUIT,DISPLAY>1 W !,IBDASH S IBCOUNT=IBCOUNT+1
;
I 'IBQUIT,IBCOUNT>2 S IBQUIT=$$EOP
Q
;
SETLN(LINE) ; set line as next line for current policy
N CNT,POL S LINE=$G(LINE)
S POL=+$G(^TMP($J,"IBCNS3"))
I 'POL S POL=$O(^TMP($J,"IBCNS3","~"),-1)+1 S ^TMP($J,"IBCNS3")=POL
;
S CNT=+$G(^TMP($J,"IBCNS3",POL))+1
S ^TMP($J,"IBCNS3",POL)=CNT
S ^TMP($J,"IBCNS3",POL,CNT)=LINE
Q
;
;
;
GETLN(IBPOL0,IBDATE) ; get single line of primary data on insurance policy
; input: IBPOL0 = line from array, zero node of patient policy (2,.312)
; IBDATE = date to check coverage, default today
; output: formatted line of data for insurance policy in TMP($J,"IBCNS")
;
N IBX,IBLINE S IBLINE=" " S IBPOL0=$G(IBPOL0)
;
S IBX=$G(^DIC(36,+IBPOL0,0)),IBX=$S($P(IBX,U,1)'="":$P(IBX,U,1),1:"UNKNOWN") S IBLINE=$$FRMLN(IBX,IBLINE,11,0)
S IBX=$P(IBPOL0,U,20),IBX=$S(IBX=1:"p",IBX=2:"s",IBX=3:"t",1:"") S IBLINE=$$FRMLN(IBX,IBLINE,1,14)
S IBX=$P(IBPOL0,U,2) S IBLINE=$$FRMLN(IBX,IBLINE,16,17)
S IBX=$$FNDGRP($P(IBPOL0,U,18)) S IBLINE=$$FRMLN(IBX,IBLINE,10,35)
S IBX=$P(IBPOL0,U,6),IBX=$S(IBX="v":"SELF",IBX="s":"SPOUSE",1:"OTHER") S IBLINE=$$FRMLN(IBX,IBLINE,7,47)
S IBX=$$DAT1^IBOUTL($P(IBPOL0,U,8)) S IBLINE=$$FRMLN(IBX,IBLINE,8,55)
S IBX=$$DAT1^IBOUTL($P(IBPOL0,U,4)) S IBLINE=$$FRMLN(IBX,IBLINE,8,65)
S IBX=$$FNDCOV(+IBPOL0,+$P(IBPOL0,U,18),$G(IBDATE)) S IBLINE=$$FRMLN(IBX,IBLINE,6,74)
;
D SETLN(IBLINE)
GETLNQ Q
;
;
GETEXT(DFN,IBPOLFN,IBPOL0,DATE) ; display extended insurance information
; Plan Filing Timeframe, Plan Coverage, Conditional Coverage Comments, and Riders
; input: DFN = pointer to patient (2)
; IBPOLFN = pointer to patient insurance policy in 2.312
; IBPOL0 = line from array, zero node of patient policy (2,.312)
; DATE = date to check coverage, default today
; DISPARR = array to pass data back in, pass by reference
; output: array of extended data in TMP($J,"IBCNS")
;
N IBX,IBY,IBZ,IBC,IBINSFN,IBPLNFN,IBPLN0,IBLINE,IBCAT,IBCATFN,IBCOVRD,IBU,ARR,ARR1 S:'$G(DATE) DATE=DT
S IBINSFN=+$G(IBPOL0) Q:'IBINSFN S IBPLNFN=+$P(IBPOL0,U,18),IBPLN0=$G(^IBA(355.3,IBPLNFN,0)) Q:IBPLN0=""
;
S IBLINE="Last Verified: ",(IBY,IBX)=""
S IBY=$P($G(^DPT(DFN,.312,IBPOLFN,1)),U,3) I IBY'="" S IBX=$$DAT1^IBOUTL(IBY) S IBLINE=IBLINE_IBX D SETLN(" "),SETLN(IBLINE)
;
S IBLINE="Plan Filing Time Frame: "
S IBY=$P(IBPLN0,U,13) S:IBY'="" IBY=IBY_" " I +$P(IBPLN0,U,16) S IBY=IBY_"("_$$FTFN^IBCNSU31(IBPLNFN)_")"
I IBY'="" S IBLINE=IBLINE_IBY D:IBX="" SETLN(" ") D SETLN(IBLINE)
;
S IBLINE="Insurance Comp: "
I $P($G(^DIC(36,IBINSFN,0)),U,2)="N" S IBLINE=IBLINE_"Will Not Reimburse" D SETLN(" "),SETLN(IBLINE)
;
S IBLINE="Conditional: ",IBCOVRD="",IBU=""
K ARR F IBCAT="INPATIENT","OUTPATIENT","PHARMACY","MENTAL HEALTH","DENTAL","LONG TERM CARE" D
. S IBCATFN=+$O(^IBE(355.31,"B",IBCAT,"")) Q:'IBCATFN
. S IBY=$$PLCOV^IBCNSU3(+IBPLNFN,DATE,IBCATFN,.ARR) Q:IBY'>0
. I IBY=1 S IBCOVRD=$G(IBCOVRD)_IBU_$S(IBCAT["PATIENT":$P(IBCAT,"IENT",1),1:IBCAT),IBU=", " Q
. S IBX=IBCAT_": ",IBC=$G(IBC)+100 S IBLINE=$$FRMLN(IBX,IBLINE,15,17)
. S IBZ=0 F S IBZ=$O(ARR(IBZ)) Q:'IBZ S IBX=ARR(IBZ) D S IBLINE=""
.. S IBLINE=$$FRMLN(IBX,IBLINE,46,33) S ARR1(IBC+IBZ)=IBLINE
I IBCOVRD'="" S IBLINE="Plan Coverage: "_$G(IBCOVRD) D SETLN(" "),SETLN(IBLINE)
I $O(ARR1("")) D:IBCOVRD="" SETLN(" ") S IBZ=0 F S IBZ=$O(ARR1(IBZ)) Q:'IBZ S IBX=ARR1(IBZ) D SETLN(IBX)
;
S IBLINE="Policy Riders: "
K ARR D RIDERS^IBCNSU3(+$G(DFN),+$G(IBPOLFN),.ARR) I $O(ARR("")) D SETLN(" ")
S IBZ=0 F S IBZ=$O(ARR(IBZ)) Q:'IBZ S IBX=ARR(IBZ) D S IBLINE=""
. S IBLINE=$$FRMLN(IBX,IBLINE,62,17) D SETLN(IBLINE)
Q
;
;
GETCOM(IBPLNFN,IBPOL1) ; get patient insurance and plan insurance comments in TMP($J,"IBCNS")
N IBX,IBY
;
S IBX=$P($G(IBPOL1),U,8) I IBX'="" S IBY="Patient Policy Comments: " D SETLN(" "),SETLN(IBY),SETLN(IBX)
;
I +$G(IBPLNFN),$O(^IBA(355.3,+IBPLNFN,11,0)) S IBX="Group/Plan Comments:" D SETLN(" "),SETLN(IBX) D
. S IBX=0 F S IBX=$O(^IBA(355.3,+IBPLNFN,11,IBX)) Q:'IBX S IBY=$G(^IBA(355.3,+IBPLNFN,11,IBX,0)) D SETLN(IBY)
Q
;
;
GETNOTES(DFN) ; get final notes/warnings in TMP($J,"IBCNS")
N IBX,IBY,IBLINE1,IBLINE2,IBFND S (IBFND,IBLINE1,IBLINE2)="" Q:'$G(DFN)
;
S IBX=+$G(^IBA(354,DFN,60)) I +IBX S IBY="*** Verification of No Coverage "_$$FMTE^XLFDT(IBX)_" ***" S IBLINE1=$$FRMLN(IBY,"",60,16),IBFND=1
I $$BUFFER^IBCNBU1(DFN) S IBY="*** Patient has Insurance Buffer entries ***" S IBLINE2=$$FRMLN(IBY,"",50,17),IBFND=1
;
I +IBFND D SETLN(" ") D:IBLINE1'="" SETLN(IBLINE1) D:IBLINE2'="" SETLN(IBLINE2) D SETLN(" ")
;
Q
;
;
EB(DFN,IBCDFN) ; Build eIV elig/benefit display for ?INX screen display
NEW IBX,IBY
D INIT^IBCNES(2.322,IBCDFN_","_DFN_",","A",,"?INX")
D SETLN(" ")
D SETLN("eIV Eligibility/Benefit Information:")
S IBX=0
F S IBX=$O(^TMP("?INX",$J,"DISP",IBX)) Q:'IBX D
. S IBY=$G(^TMP("?INX",$J,"DISP",IBX,0))
. D SETLN(IBY)
. Q
;
; clean up scratch global
K ^TMP("?INX",$J)
;
EBX ;
Q
;
;
FRMLN(FIELD,IBLINE,FLNG,COL) ; format line data fields, returns IBLINE with FIELD of length FLNG at column COL
N IBNEW,IBL S FIELD=$G(FIELD),IBLINE=$G(IBLINE),FLNG=$G(FLNG),COL=$G(COL)
;
S IBNEW=$E(IBLINE,1,COL),IBL=$L(IBNEW),IBNEW=IBNEW_$J("",COL-IBL)
S IBNEW=IBNEW_$E(FIELD,1,FLNG),IBL=$L(FIELD),IBNEW=IBNEW_$J("",FLNG-IBL)
S IBNEW=IBNEW_$E(IBLINE,COL+FLNG+1,9999)
Q IBNEW
;
;
;
FNDCOV(IBINSFN,IBPLNFN,IBDATE) ; -- return group/plan coverage limitations indications
; input: IBINSFN = pointer to insurance company entry in 36
; IBPLNFN = pointer to insurance plan entry in 355.3
; IBDATE = date to check coverage, default today
; output: if insurance company will not reimburse = WNR, if all covered then returns null
; otherwise list of first characters of types covered, if conditional then character in lower case
;
N IBOUT,IBX,IBY,IBCAT,IBCATFN S IBOUT="" S:'$G(IBDATE) IBDATE=DT I '$G(IBINSFN)!'$G(IBPLNFN) G FNDCOVQ
;
I $P($G(^DIC(36,+IBINSFN,0)),U,2)="N" S IBOUT="*WNR*" G FNDCOVQ
F IBCAT="INPATIENT","OUTPATIENT","PHARMACY","MENTAL HEALTH","DENTAL","LONG TERM CARE" D
. S IBCATFN=+$O(^IBE(355.31,"B",IBCAT,"")) Q:'IBCATFN
. S IBY=$$PLCOV^IBCNSU3(+IBPLNFN,IBDATE,+IBCATFN) Q:'IBY
. S IBX=$S(IBCAT="PHARMACY":"R",1:$E(IBCAT)) S:IBY>1 IBX=$C($A(IBX)+32) S IBOUT=IBOUT_IBX
S:IBOUT="" IBOUT="no CV" I IBOUT?6U S IBOUT=""
FNDCOVQ Q IBOUT
;
;
FNDGRP(IBPLNFN) ; -- return group name/group policy
; input: IBPLNFN = pointer to insurance plan entry in 355.3
; output: group name or group number, if both group NUMBER, check for Individual plans
;
;IB*2.0*516/TAZ - Use HIPAA compliant fields
;N IBX,IBOUT S IBOUT=""
;S IBX=$G(^IBA(355.3,+$G(IBPLNFN),0))
;S IBOUT=$S($P(IBX,U,4)'="":$P(IBX,U,4),1:$P(IBX,U,3))
;I $P(IBX,U,10) S IBOUT="Ind. Plan "_IBOUT
FNDGRPQ ;
;Q IBOUT
Q $$GRP^IBCNS(+$G(IBPLNFN))
;
;
;
;
HDR ; -- print header
N IBX W @IOF
W !,"Insurance",?13,"COB",?17,"Subscriber ID",?35,"Group",?47,"Holder",?55,"Effectve",?65,"Expires",?75,"Only"
S IBX="",$P(IBX,"=",80)="=" W !,IBX
Q
;
EOP() ; ask user for return at end of page, return 1 if '^' entered
N IBQ,DIR,DIRUT,DUOUT,DTOUT,X,Y W ! S IBQ=0,DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBQ=1
Q IBQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNS3 9804 printed Apr 09, 2024@21:18:38 Page 2
IBCNS3 ;ALB/ARH - DISPLAY EXTENDED INSURANCE ; 01-DEC-04
+1 ;;2.0;INTEGRATED BILLING;**287,399,416,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
DISP(DFN,DATE,DISPLAY) ; Display all insurance company information
+1 ; input: DFN = pointer to patient
+2 ; DATE = date to check for coverage and riders
+3 ; DISPLAY = contain indicators of data to display (1234)
+4 ; 1 : first line of display ins company and plan data
+5 ; 2 : extended data (Plan Filing Timeframe, Plan Coverage, Conditional Coverage Comments, and Riders)
+6 ; 3 : ins. policy comments and plan comments
+7 ; 4 : eIV eligibility/benefit information (IB*2*416)
+8 ;
+9 if '$GET(DFN)
QUIT
if '$DATA(IOF)
DO HOME^%ZIS
+10 NEW IBINS,IBPOLFN,IBPOL0,IBPLNFN
SET DISPLAY=$GET(DISPLAY)
IF '$GET(DATE)
SET DATE=DT
+11 KILL ^TMP($JOB,"IBCNS3")
+12 ;
+13 DO ALL^IBCNS1(DFN,"IBINS",3,DATE)
+14 ;
+15 IF '$DATA(IBINS)
DO SETLN(" ")
DO SETLN("No Insurance Information")
+16 ;
+17 SET IBPOLFN=0
FOR
SET IBPOLFN=$ORDER(IBINS(IBPOLFN))
if 'IBPOLFN
QUIT
Begin DoDot:1
+18 SET IBPOL0=IBINS(IBPOLFN,0)
SET IBPLNFN=$PIECE(IBPOL0,U,18)
+19 SET ^TMP($JOB,"IBCNS3")=IBPOLFN
+20 ;
+21 DO GETLN(IBPOL0,DATE)
+22 ; display extended
IF DISPLAY[2
DO GETEXT(DFN,IBPOLFN,IBPOL0,DATE)
+23 ; display extended 3, comments
IF DISPLAY[3
DO GETCOM(IBPLNFN,$GET(IBINS(IBPOLFN,1)))
+24 ; display eIV elig/ben data
IF DISPLAY[4
DO EB(DFN,IBPOLFN)
+25 QUIT
End DoDot:1
+26 ;
+27 ; display final notes/warning messages
SET ^TMP($JOB,"IBCNS3")=""
DO GETNOTES(DFN)
+28 ;
+29 DO PRINT
+30 ;
DISPQ KILL ^TMP($JOB,"IBCNS3")
+1 QUIT
+2 ;
PRINT ; display compiled array of patient insurance information in ^TMP($J,"IBCNS3")
+1 NEW IBSUB,IBCOUNT,IBQUIT,IBLEVEL,IBLNX,IBDASH,IBLINE,IBCNTLN
SET $PIECE(IBDASH,"-",80)="-"
SET DISPLAY=+$GET(DISPLAY)
+2 ;
+3 DO HDR
SET IBSUB="IBCNS3"
SET IBCOUNT=3
SET IBQUIT=0
+4 ;
+5 SET IBLEVEL=0
FOR
SET IBLEVEL=$ORDER(^TMP($JOB,IBSUB,IBLEVEL))
if 'IBLEVEL
QUIT
Begin DoDot:1
+6 SET IBCNTLN=+$GET(^TMP($JOB,IBSUB,IBLEVEL))+1
+7 ;
+8 IF IBCOUNT>10
IF (IBCNTLN+IBCOUNT)>(IOSL-3)
SET IBQUIT=$$EOP
if IBQUIT
QUIT
DO HDR
SET IBCOUNT=3
+9 ;
+10 SET IBLNX=0
FOR
SET IBLNX=$ORDER(^TMP($JOB,IBSUB,IBLEVEL,IBLNX))
if 'IBLNX
QUIT
Begin DoDot:2
+11 ;
+12 SET IBLINE=$GET(^TMP($JOB,IBSUB,IBLEVEL,IBLNX))
+13 ;
+14 WRITE !,IBLINE
SET IBCOUNT=IBCOUNT+1
IF IBCOUNT>(IOSL-3)
SET IBQUIT=$$EOP
if IBQUIT
QUIT
WRITE @IOF
SET IBCOUNT=2
End DoDot:2
if IBQUIT
QUIT
+15 ;
+16 IF 'IBQUIT
IF DISPLAY>1
WRITE !,IBDASH
SET IBCOUNT=IBCOUNT+1
End DoDot:1
if IBQUIT
QUIT
+17 ;
+18 IF 'IBQUIT
IF IBCOUNT>2
SET IBQUIT=$$EOP
+19 QUIT
+20 ;
SETLN(LINE) ; set line as next line for current policy
+1 NEW CNT,POL
SET LINE=$GET(LINE)
+2 SET POL=+$GET(^TMP($JOB,"IBCNS3"))
+3 IF 'POL
SET POL=$ORDER(^TMP($JOB,"IBCNS3","~"),-1)+1
SET ^TMP($JOB,"IBCNS3")=POL
+4 ;
+5 SET CNT=+$GET(^TMP($JOB,"IBCNS3",POL))+1
+6 SET ^TMP($JOB,"IBCNS3",POL)=CNT
+7 SET ^TMP($JOB,"IBCNS3",POL,CNT)=LINE
+8 QUIT
+9 ;
+10 ;
+11 ;
GETLN(IBPOL0,IBDATE) ; get single line of primary data on insurance policy
+1 ; input: IBPOL0 = line from array, zero node of patient policy (2,.312)
+2 ; IBDATE = date to check coverage, default today
+3 ; output: formatted line of data for insurance policy in TMP($J,"IBCNS")
+4 ;
+5 NEW IBX,IBLINE
SET IBLINE=" "
SET IBPOL0=$GET(IBPOL0)
+6 ;
+7 SET IBX=$GET(^DIC(36,+IBPOL0,0))
SET IBX=$SELECT($PIECE(IBX,U,1)'="":$PIECE(IBX,U,1),1:"UNKNOWN")
SET IBLINE=$$FRMLN(IBX,IBLINE,11,0)
+8 SET IBX=$PIECE(IBPOL0,U,20)
SET IBX=$SELECT(IBX=1:"p",IBX=2:"s",IBX=3:"t",1:"")
SET IBLINE=$$FRMLN(IBX,IBLINE,1,14)
+9 SET IBX=$PIECE(IBPOL0,U,2)
SET IBLINE=$$FRMLN(IBX,IBLINE,16,17)
+10 SET IBX=$$FNDGRP($PIECE(IBPOL0,U,18))
SET IBLINE=$$FRMLN(IBX,IBLINE,10,35)
+11 SET IBX=$PIECE(IBPOL0,U,6)
SET IBX=$SELECT(IBX="v":"SELF",IBX="s":"SPOUSE",1:"OTHER")
SET IBLINE=$$FRMLN(IBX,IBLINE,7,47)
+12 SET IBX=$$DAT1^IBOUTL($PIECE(IBPOL0,U,8))
SET IBLINE=$$FRMLN(IBX,IBLINE,8,55)
+13 SET IBX=$$DAT1^IBOUTL($PIECE(IBPOL0,U,4))
SET IBLINE=$$FRMLN(IBX,IBLINE,8,65)
+14 SET IBX=$$FNDCOV(+IBPOL0,+$PIECE(IBPOL0,U,18),$GET(IBDATE))
SET IBLINE=$$FRMLN(IBX,IBLINE,6,74)
+15 ;
+16 DO SETLN(IBLINE)
GETLNQ QUIT
+1 ;
+2 ;
GETEXT(DFN,IBPOLFN,IBPOL0,DATE) ; display extended insurance information
+1 ; Plan Filing Timeframe, Plan Coverage, Conditional Coverage Comments, and Riders
+2 ; input: DFN = pointer to patient (2)
+3 ; IBPOLFN = pointer to patient insurance policy in 2.312
+4 ; IBPOL0 = line from array, zero node of patient policy (2,.312)
+5 ; DATE = date to check coverage, default today
+6 ; DISPARR = array to pass data back in, pass by reference
+7 ; output: array of extended data in TMP($J,"IBCNS")
+8 ;
+9 NEW IBX,IBY,IBZ,IBC,IBINSFN,IBPLNFN,IBPLN0,IBLINE,IBCAT,IBCATFN,IBCOVRD,IBU,ARR,ARR1
if '$GET(DATE)
SET DATE=DT
+10 SET IBINSFN=+$GET(IBPOL0)
if 'IBINSFN
QUIT
SET IBPLNFN=+$PIECE(IBPOL0,U,18)
SET IBPLN0=$GET(^IBA(355.3,IBPLNFN,0))
if IBPLN0=""
QUIT
+11 ;
+12 SET IBLINE="Last Verified: "
SET (IBY,IBX)=""
+13 SET IBY=$PIECE($GET(^DPT(DFN,.312,IBPOLFN,1)),U,3)
IF IBY'=""
SET IBX=$$DAT1^IBOUTL(IBY)
SET IBLINE=IBLINE_IBX
DO SETLN(" ")
DO SETLN(IBLINE)
+14 ;
+15 SET IBLINE="Plan Filing Time Frame: "
+16 SET IBY=$PIECE(IBPLN0,U,13)
if IBY'=""
SET IBY=IBY_" "
IF +$PIECE(IBPLN0,U,16)
SET IBY=IBY_"("_$$FTFN^IBCNSU31(IBPLNFN)_")"
+17 IF IBY'=""
SET IBLINE=IBLINE_IBY
if IBX=""
DO SETLN(" ")
DO SETLN(IBLINE)
+18 ;
+19 SET IBLINE="Insurance Comp: "
+20 IF $PIECE($GET(^DIC(36,IBINSFN,0)),U,2)="N"
SET IBLINE=IBLINE_"Will Not Reimburse"
DO SETLN(" ")
DO SETLN(IBLINE)
+21 ;
+22 SET IBLINE="Conditional: "
SET IBCOVRD=""
SET IBU=""
+23 KILL ARR
FOR IBCAT="INPATIENT","OUTPATIENT","PHARMACY","MENTAL HEALTH","DENTAL","LONG TERM CARE"
Begin DoDot:1
+24 SET IBCATFN=+$ORDER(^IBE(355.31,"B",IBCAT,""))
if 'IBCATFN
QUIT
+25 SET IBY=$$PLCOV^IBCNSU3(+IBPLNFN,DATE,IBCATFN,.ARR)
if IBY'>0
QUIT
+26 IF IBY=1
SET IBCOVRD=$GET(IBCOVRD)_IBU_$SELECT(IBCAT["PATIENT":$PIECE(IBCAT,"IENT",1),1:IBCAT)
SET IBU=", "
QUIT
+27 SET IBX=IBCAT_": "
SET IBC=$GET(IBC)+100
SET IBLINE=$$FRMLN(IBX,IBLINE,15,17)
+28 SET IBZ=0
FOR
SET IBZ=$ORDER(ARR(IBZ))
if 'IBZ
QUIT
SET IBX=ARR(IBZ)
Begin DoDot:2
+29 SET IBLINE=$$FRMLN(IBX,IBLINE,46,33)
SET ARR1(IBC+IBZ)=IBLINE
End DoDot:2
SET IBLINE=""
End DoDot:1
+30 IF IBCOVRD'=""
SET IBLINE="Plan Coverage: "_$GET(IBCOVRD)
DO SETLN(" ")
DO SETLN(IBLINE)
+31 IF $ORDER(ARR1(""))
if IBCOVRD=""
DO SETLN(" ")
SET IBZ=0
FOR
SET IBZ=$ORDER(ARR1(IBZ))
if 'IBZ
QUIT
SET IBX=ARR1(IBZ)
DO SETLN(IBX)
+32 ;
+33 SET IBLINE="Policy Riders: "
+34 KILL ARR
DO RIDERS^IBCNSU3(+$GET(DFN),+$GET(IBPOLFN),.ARR)
IF $ORDER(ARR(""))
DO SETLN(" ")
+35 SET IBZ=0
FOR
SET IBZ=$ORDER(ARR(IBZ))
if 'IBZ
QUIT
SET IBX=ARR(IBZ)
Begin DoDot:1
+36 SET IBLINE=$$FRMLN(IBX,IBLINE,62,17)
DO SETLN(IBLINE)
End DoDot:1
SET IBLINE=""
+37 QUIT
+38 ;
+39 ;
GETCOM(IBPLNFN,IBPOL1) ; get patient insurance and plan insurance comments in TMP($J,"IBCNS")
+1 NEW IBX,IBY
+2 ;
+3 SET IBX=$PIECE($GET(IBPOL1),U,8)
IF IBX'=""
SET IBY="Patient Policy Comments: "
DO SETLN(" ")
DO SETLN(IBY)
DO SETLN(IBX)
+4 ;
+5 IF +$GET(IBPLNFN)
IF $ORDER(^IBA(355.3,+IBPLNFN,11,0))
SET IBX="Group/Plan Comments:"
DO SETLN(" ")
DO SETLN(IBX)
Begin DoDot:1
+6 SET IBX=0
FOR
SET IBX=$ORDER(^IBA(355.3,+IBPLNFN,11,IBX))
if 'IBX
QUIT
SET IBY=$GET(^IBA(355.3,+IBPLNFN,11,IBX,0))
DO SETLN(IBY)
End DoDot:1
+7 QUIT
+8 ;
+9 ;
GETNOTES(DFN) ; get final notes/warnings in TMP($J,"IBCNS")
+1 NEW IBX,IBY,IBLINE1,IBLINE2,IBFND
SET (IBFND,IBLINE1,IBLINE2)=""
if '$GET(DFN)
QUIT
+2 ;
+3 SET IBX=+$GET(^IBA(354,DFN,60))
IF +IBX
SET IBY="*** Verification of No Coverage "_$$FMTE^XLFDT(IBX)_" ***"
SET IBLINE1=$$FRMLN(IBY,"",60,16)
SET IBFND=1
+4 IF $$BUFFER^IBCNBU1(DFN)
SET IBY="*** Patient has Insurance Buffer entries ***"
SET IBLINE2=$$FRMLN(IBY,"",50,17)
SET IBFND=1
+5 ;
+6 IF +IBFND
DO SETLN(" ")
if IBLINE1'=""
DO SETLN(IBLINE1)
if IBLINE2'=""
DO SETLN(IBLINE2)
DO SETLN(" ")
+7 ;
+8 QUIT
+9 ;
+10 ;
EB(DFN,IBCDFN) ; Build eIV elig/benefit display for ?INX screen display
+1 NEW IBX,IBY
+2 DO INIT^IBCNES(2.322,IBCDFN_","_DFN_",","A",,"?INX")
+3 DO SETLN(" ")
+4 DO SETLN("eIV Eligibility/Benefit Information:")
+5 SET IBX=0
+6 FOR
SET IBX=$ORDER(^TMP("?INX",$JOB,"DISP",IBX))
if 'IBX
QUIT
Begin DoDot:1
+7 SET IBY=$GET(^TMP("?INX",$JOB,"DISP",IBX,0))
+8 DO SETLN(IBY)
+9 QUIT
End DoDot:1
+10 ;
+11 ; clean up scratch global
+12 KILL ^TMP("?INX",$JOB)
+13 ;
EBX ;
+1 QUIT
+2 ;
+3 ;
FRMLN(FIELD,IBLINE,FLNG,COL) ; format line data fields, returns IBLINE with FIELD of length FLNG at column COL
+1 NEW IBNEW,IBL
SET FIELD=$GET(FIELD)
SET IBLINE=$GET(IBLINE)
SET FLNG=$GET(FLNG)
SET COL=$GET(COL)
+2 ;
+3 SET IBNEW=$EXTRACT(IBLINE,1,COL)
SET IBL=$LENGTH(IBNEW)
SET IBNEW=IBNEW_$JUSTIFY("",COL-IBL)
+4 SET IBNEW=IBNEW_$EXTRACT(FIELD,1,FLNG)
SET IBL=$LENGTH(FIELD)
SET IBNEW=IBNEW_$JUSTIFY("",FLNG-IBL)
+5 SET IBNEW=IBNEW_$EXTRACT(IBLINE,COL+FLNG+1,9999)
+6 QUIT IBNEW
+7 ;
+8 ;
+9 ;
FNDCOV(IBINSFN,IBPLNFN,IBDATE) ; -- return group/plan coverage limitations indications
+1 ; input: IBINSFN = pointer to insurance company entry in 36
+2 ; IBPLNFN = pointer to insurance plan entry in 355.3
+3 ; IBDATE = date to check coverage, default today
+4 ; output: if insurance company will not reimburse = WNR, if all covered then returns null
+5 ; otherwise list of first characters of types covered, if conditional then character in lower case
+6 ;
+7 NEW IBOUT,IBX,IBY,IBCAT,IBCATFN
SET IBOUT=""
if '$GET(IBDATE)
SET IBDATE=DT
IF '$GET(IBINSFN)!'$GET(IBPLNFN)
GOTO FNDCOVQ
+8 ;
+9 IF $PIECE($GET(^DIC(36,+IBINSFN,0)),U,2)="N"
SET IBOUT="*WNR*"
GOTO FNDCOVQ
+10 FOR IBCAT="INPATIENT","OUTPATIENT","PHARMACY","MENTAL HEALTH","DENTAL","LONG TERM CARE"
Begin DoDot:1
+11 SET IBCATFN=+$ORDER(^IBE(355.31,"B",IBCAT,""))
if 'IBCATFN
QUIT
+12 SET IBY=$$PLCOV^IBCNSU3(+IBPLNFN,IBDATE,+IBCATFN)
if 'IBY
QUIT
+13 SET IBX=$SELECT(IBCAT="PHARMACY":"R",1:$EXTRACT(IBCAT))
if IBY>1
SET IBX=$CHAR($ASCII(IBX)+32)
SET IBOUT=IBOUT_IBX
End DoDot:1
+14 if IBOUT=""
SET IBOUT="no CV"
IF IBOUT?6U
SET IBOUT=""
FNDCOVQ QUIT IBOUT
+1 ;
+2 ;
FNDGRP(IBPLNFN) ; -- return group name/group policy
+1 ; input: IBPLNFN = pointer to insurance plan entry in 355.3
+2 ; output: group name or group number, if both group NUMBER, check for Individual plans
+3 ;
+4 ;IB*2.0*516/TAZ - Use HIPAA compliant fields
+5 ;N IBX,IBOUT S IBOUT=""
+6 ;S IBX=$G(^IBA(355.3,+$G(IBPLNFN),0))
+7 ;S IBOUT=$S($P(IBX,U,4)'="":$P(IBX,U,4),1:$P(IBX,U,3))
+8 ;I $P(IBX,U,10) S IBOUT="Ind. Plan "_IBOUT
FNDGRPQ ;
+1 ;Q IBOUT
+2 QUIT $$GRP^IBCNS(+$GET(IBPLNFN))
+3 ;
+4 ;
+5 ;
+6 ;
HDR ; -- print header
+1 NEW IBX
WRITE @IOF
+2 WRITE !,"Insurance",?13,"COB",?17,"Subscriber ID",?35,"Group",?47,"Holder",?55,"Effectve",?65,"Expires",?75,"Only"
+3 SET IBX=""
SET $PIECE(IBX,"=",80)="="
WRITE !,IBX
+4 QUIT
+5 ;
EOP() ; ask user for return at end of page, return 1 if '^' entered
+1 NEW IBQ,DIR,DIRUT,DUOUT,DTOUT,X,Y
WRITE !
SET IBQ=0
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DIRUT))
SET IBQ=1
+2 QUIT IBQ
