IBJTNB ;ALB/ARH - TPI INSURANCE POLICY/AB SCREENS/ACTIONS ; 12/31/15
;;2.0;INTEGRATED BILLING ;**39,549**; 21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
;
HDRP ; -- IBJT NS VIEW EXP POL LIST TEMPLATE: policy header code
S VALMHDR(1)="Expanded Policy Information" N IBI,IBX
I $D(IBPPOL) D HDR^IBCNSP,PST(1)
Q
INITP ; -- IBJT NS VIEW EXP POL LIST TEMPLATE: policy init code
K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPD",$J)
;
; IB*2.0*549 Replaced 'IBT SHORT MENU' with 'IBJT SHORT MENU 2' below
I '$G(IBIFN) D PRTCL^IBJU1("IBJT SHORT MENU 2")
I IBJPOL>0 S IBPPOL="^2^"_DFN_"^"_+IBJPOL_"^"_$G(^DPT(DFN,.312,+IBJPOL,0)) D INIT^IBCNSP K VALMHDR Q
S VALMCNT=0 D BLD("Insurance data incomplete, cannot find policy.")
Q
EXITP D EXIT^IBCNSP K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPD",$J) Q
HELPP D HELP^IBCNSP Q
;
VP(REDISP) ; -- IBJT NS VIEW EXP POL SCREEN ACTION: patient policy info screen
; user can select policy if more than one for bill, REDISP set if screen to be rebuilt for different policy
;
I '$G(REDISP) N IBX,IBVIEW,IBCHANGE,IBCNS,IBCPOL,IBPPOL,IBJPOL,IBCDFN,IBI,IBLCNT,IBPR,IBPRD
I '$G(IBIFN)!'$G(DFN) G VPQ
D FULL^VALM1
S IBX=$$PST^IBJTU31(IBIFN) I 'IBX S VALMBCK="R" G VPQ
S IBJPOL=IBX
I '$G(REDISP) D EN^VALM("IBJT NS VIEW EXP POL") G VPQ
D INITP S VALMBCK="R"
VPQ Q
;
;
HDRA ; -- IBJT NS VIEW AN BEN LIST TEMPLATE: annual benefits header code
S VALMHDR(1)="Annual Benefits Information",IBCGN=$G(IBCGN),IBYE=$G(IBYE)
I +$G(IBCPOL)>0 D HDR^IBCNSA("Annual Benefits") D PST(1)
Q
INITA ; -- IBJT NS VIEW AN BEN LIST TEMPLATE: annual benefits init code
; allow select of other benefit years, after first display of policy
N IBJMSG K IBYR S VALMCNT=0 I +IBJPOL<0 S IBJMSG="Insurance data incomplete, cannot find policy." G IA1
S IBCPOL=+$P(IBJPOL,U,20) I 'IBCPOL S IBJMSG="No Policy found." G IA1
I '$O(^IBA(355.4,"APY",+IBCPOL,"")) S IBJMSG="Policy has No Annual Benefits Records." G IA1
I +$G(IBIFN),'$D(IBJAB(IBCPOL)),$G(IBJMSG)="" D S IBJAB(IBCPOL)=""
. S IBEVDT=$E(+$G(^DGCR(399,+IBIFN,"U")),1,7),IBDT=-IBEVDT-.01
. S IBDT=$O(^IBA(355.4,"APY",IBCPOL,IBDT))
. I 'IBDT!($$FMDIFF^XLFDT(IBEVDT,-IBDT)>365) S IBJMSG="No Annual Benefits cover begin date of bill ("_$$DATE^IBJU1(IBEVDT)_")." Q
. S IBYR=-IBDT,IBCAB=$O(^IBA(355.4,"APY",IBCPOL,IBDT,""))
. I 'IBCAB S IBJMSG="No Annual Benefits record found."
IA1 I '$G(IBIFN) D PRTCL^IBJU1("IBJT SHORT MENU")
I $G(IBJMSG)'="" K ^TMP("IBCNSA",$J) D BLD(IBJMSG) K VALMHDR Q
D INIT^IBCNSA I '$D(VALMQUIT) K VALMHDR
Q
EXITA D EXIT^IBCNSA K IBJAB,^TMP("IBCNSA",$J) Q
HELPA D HELP^IBCNSA Q
;
AB(REDISP) ; -- IBJT NS VIEW AN BEN SCREEN ACTION: patient policy annual benefits for year which contains the bill's
; Statement From Date, once the annual benefits of the policy that covers the bill's year has been
; displayed, the user will be allowed to pick other AB years for the policy
; user can select policy if more than one on bill, REDISP set if screen to be rebuilt for different policy
;
I '$G(REDISP) N IBEVDT,IBDT,IBYR,IBCAB,IBX,IBVIEW,IBCHANGE,IBCNS,IBCPOL,IBPPOL,IBCGN,IBYE,IBJPOL,IBI,IBDUZ,IBDA,IBCNT,OFFSET,START
I '$G(IBIFN)!'$G(DFN) G ABQ
D FULL^VALM1
S IBX=$$PST^IBJTU31(IBIFN) I 'IBX S VALMBCK="R" G ABQ
S IBJPOL=IBX
I '$G(REDISP) D EN^VALM("IBJT NS VIEW AN BEN") G ABQ
D INITA S VALMBCK="R"
ABQ Q
;
;
BLD(MSG) D KILL^VALM10(),SET^IBCNSP(1,1,""),SET^IBCNSP(2,1,MSG) Q
PST(X) S IBI=$P(IBJPOL,U,2),IBX=$S(IBI=1:"Primary",IBI=2:"Secondary",IBI=3:"Tertiary",1:""),VALMHDR(X)=$E(VALMHDR(X),1,68)_$J("",(79-$L(VALMHDR(X))-$L(IBX)))_IBX Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTNB 3663 printed Apr 09, 2024@21:25:21 Page 2
IBJTNB ;ALB/ARH - TPI INSURANCE POLICY/AB SCREENS/ACTIONS ; 12/31/15
+1 ;;2.0;INTEGRATED BILLING ;**39,549**; 21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
HDRP ; -- IBJT NS VIEW EXP POL LIST TEMPLATE: policy header code
+1 SET VALMHDR(1)="Expanded Policy Information"
NEW IBI,IBX
+2 IF $DATA(IBPPOL)
DO HDR^IBCNSP
DO PST(1)
+3 QUIT
INITP ; -- IBJT NS VIEW EXP POL LIST TEMPLATE: policy init code
+1 KILL ^TMP("IBCNSVP",$JOB),^TMP("IBCNSVPD",$JOB)
+2 ;
+3 ; IB*2.0*549 Replaced 'IBT SHORT MENU' with 'IBJT SHORT MENU 2' below
+4 IF '$GET(IBIFN)
DO PRTCL^IBJU1("IBJT SHORT MENU 2")
+5 IF IBJPOL>0
SET IBPPOL="^2^"_DFN_"^"_+IBJPOL_"^"_$GET(^DPT(DFN,.312,+IBJPOL,0))
DO INIT^IBCNSP
KILL VALMHDR
QUIT
+6 SET VALMCNT=0
DO BLD("Insurance data incomplete, cannot find policy.")
+7 QUIT
EXITP DO EXIT^IBCNSP
KILL ^TMP("IBCNSVP",$JOB),^TMP("IBCNSVPD",$JOB)
QUIT
HELPP DO HELP^IBCNSP
QUIT
+1 ;
VP(REDISP) ; -- IBJT NS VIEW EXP POL SCREEN ACTION: patient policy info screen
+1 ; user can select policy if more than one for bill, REDISP set if screen to be rebuilt for different policy
+2 ;
+3 IF '$GET(REDISP)
NEW IBX,IBVIEW,IBCHANGE,IBCNS,IBCPOL,IBPPOL,IBJPOL,IBCDFN,IBI,IBLCNT,IBPR,IBPRD
+4 IF '$GET(IBIFN)!'$GET(DFN)
GOTO VPQ
+5 DO FULL^VALM1
+6 SET IBX=$$PST^IBJTU31(IBIFN)
IF 'IBX
SET VALMBCK="R"
GOTO VPQ
+7 SET IBJPOL=IBX
+8 IF '$GET(REDISP)
DO EN^VALM("IBJT NS VIEW EXP POL")
GOTO VPQ
+9 DO INITP
SET VALMBCK="R"
VPQ QUIT
+1 ;
+2 ;
HDRA ; -- IBJT NS VIEW AN BEN LIST TEMPLATE: annual benefits header code
+1 SET VALMHDR(1)="Annual Benefits Information"
SET IBCGN=$GET(IBCGN)
SET IBYE=$GET(IBYE)
+2 IF +$GET(IBCPOL)>0
DO HDR^IBCNSA("Annual Benefits")
DO PST(1)
+3 QUIT
INITA ; -- IBJT NS VIEW AN BEN LIST TEMPLATE: annual benefits init code
+1 ; allow select of other benefit years, after first display of policy
+2 NEW IBJMSG
KILL IBYR
SET VALMCNT=0
IF +IBJPOL<0
SET IBJMSG="Insurance data incomplete, cannot find policy."
GOTO IA1
+3 SET IBCPOL=+$PIECE(IBJPOL,U,20)
IF 'IBCPOL
SET IBJMSG="No Policy found."
GOTO IA1
+4 IF '$ORDER(^IBA(355.4,"APY",+IBCPOL,""))
SET IBJMSG="Policy has No Annual Benefits Records."
GOTO IA1
+5 IF +$GET(IBIFN)
IF '$DATA(IBJAB(IBCPOL))
IF $GET(IBJMSG)=""
Begin DoDot:1
+6 SET IBEVDT=$EXTRACT(+$GET(^DGCR(399,+IBIFN,"U")),1,7)
SET IBDT=-IBEVDT-.01
+7 SET IBDT=$ORDER(^IBA(355.4,"APY",IBCPOL,IBDT))
+8 IF 'IBDT!($$FMDIFF^XLFDT(IBEVDT,-IBDT)>365)
SET IBJMSG="No Annual Benefits cover begin date of bill ("_$$DATE^IBJU1(IBEVDT)_")."
QUIT
+9 SET IBYR=-IBDT
SET IBCAB=$ORDER(^IBA(355.4,"APY",IBCPOL,IBDT,""))
+10 IF 'IBCAB
SET IBJMSG="No Annual Benefits record found."
End DoDot:1
SET IBJAB(IBCPOL)=""
IA1 IF '$GET(IBIFN)
DO PRTCL^IBJU1("IBJT SHORT MENU")
+1 IF $GET(IBJMSG)'=""
KILL ^TMP("IBCNSA",$JOB)
DO BLD(IBJMSG)
KILL VALMHDR
QUIT
+2 DO INIT^IBCNSA
IF '$DATA(VALMQUIT)
KILL VALMHDR
+3 QUIT
EXITA DO EXIT^IBCNSA
KILL IBJAB,^TMP("IBCNSA",$JOB)
QUIT
HELPA DO HELP^IBCNSA
QUIT
+1 ;
AB(REDISP) ; -- IBJT NS VIEW AN BEN SCREEN ACTION: patient policy annual benefits for year which contains the bill's
+1 ; Statement From Date, once the annual benefits of the policy that covers the bill's year has been
+2 ; displayed, the user will be allowed to pick other AB years for the policy
+3 ; user can select policy if more than one on bill, REDISP set if screen to be rebuilt for different policy
+4 ;
+5 IF '$GET(REDISP)
NEW IBEVDT,IBDT,IBYR,IBCAB,IBX,IBVIEW,IBCHANGE,IBCNS,IBCPOL,IBPPOL,IBCGN,IBYE,IBJPOL,IBI,IBDUZ,IBDA,IBCNT,OFFSET,START
+6 IF '$GET(IBIFN)!'$GET(DFN)
GOTO ABQ
+7 DO FULL^VALM1
+8 SET IBX=$$PST^IBJTU31(IBIFN)
IF 'IBX
SET VALMBCK="R"
GOTO ABQ
+9 SET IBJPOL=IBX
+10 IF '$GET(REDISP)
DO EN^VALM("IBJT NS VIEW AN BEN")
GOTO ABQ
+11 DO INITA
SET VALMBCK="R"
ABQ QUIT
+1 ;
+2 ;
BLD(MSG) DO KILL^VALM10()
DO SET^IBCNSP(1,1,"")
DO SET^IBCNSP(2,1,MSG)
QUIT
PST(X) SET IBI=$PIECE(IBJPOL,U,2)
SET IBX=$SELECT(IBI=1:"Primary",IBI=2:"Secondary",IBI=3:"Tertiary",1:"")
SET VALMHDR(X)=$EXTRACT(VALMHDR(X),1,68)_$JUSTIFY("",(79-$LENGTH(VALMHDR(X))-$LENGTH(IBX)))_IBX
QUIT
