- 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 Mar 13, 2025@21:28:59 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
