source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTNB.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1IBJTNB ;ALB/ARH - TPI INSURANCE POLICY/AB SCREENS/ACTIONS ; 2/14/95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6HDRP ; -- IBJT NS VIEW EXP POL LIST TEMPLATE: policy header code
7 S VALMHDR(1)="Expanded Policy Information" N IBI,IBX
8 I $D(IBPPOL) D HDR^IBCNSP,PST(1)
9 Q
10INITP ; -- IBJT NS VIEW EXP POL LIST TEMPLATE: policy init code
11 K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPD",$J)
12 I '$G(IBIFN) D PRTCL^IBJU1("IBJT SHORT MENU")
13 I IBJPOL>0 S IBPPOL="^2^"_DFN_"^"_+IBJPOL_"^"_$G(^DPT(DFN,.312,+IBJPOL,0)) D INIT^IBCNSP K VALMHDR Q
14 S VALMCNT=0 D BLD("Insurance data incomplete, cannot find policy.")
15 Q
16EXITP D EXIT^IBCNSP K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPD",$J) Q
17HELPP D HELP^IBCNSP Q
18 ;
19VP(REDISP) ; -- IBJT NS VIEW EXP POL SCREEN ACTION: patient policy info screen
20 ; user can select policy if more than one for bill, REDISP set if screen to be rebuilt for different policy
21 ;
22 I '$G(REDISP) N IBX,IBVIEW,IBCHANGE,IBCNS,IBCPOL,IBPPOL,IBJPOL,IBCDFN,IBI,IBLCNT,IBPR,IBPRD
23 I '$G(IBIFN)!'$G(DFN) G VPQ
24 D FULL^VALM1
25 S IBX=$$PST^IBJTU31(IBIFN) I 'IBX S VALMBCK="R" G VPQ
26 S IBJPOL=IBX
27 I '$G(REDISP) D EN^VALM("IBJT NS VIEW EXP POL") G VPQ
28 D INITP S VALMBCK="R"
29VPQ Q
30 ;
31 ;
32HDRA ; -- IBJT NS VIEW AN BEN LIST TEMPLATE: annual benefits header code
33 S VALMHDR(1)="Annual Benefits Information",IBCGN=$G(IBCGN),IBYE=$G(IBYE)
34 I +$G(IBCPOL)>0 D HDR^IBCNSA("Annual Benefits") D PST(1)
35 Q
36INITA ; -- IBJT NS VIEW AN BEN LIST TEMPLATE: annual benefits init code
37 ; allow select of other benefit years, after first display of policy
38 N IBJMSG K IBYR S VALMCNT=0 I +IBJPOL<0 S IBJMSG="Insurance data incomplete, cannot find policy." G IA1
39 S IBCPOL=+$P(IBJPOL,U,20) I 'IBCPOL S IBJMSG="No Policy found." G IA1
40 I '$O(^IBA(355.4,"APY",+IBCPOL,"")) S IBJMSG="Policy has No Annual Benefits Records." G IA1
41 I +$G(IBIFN),'$D(IBJAB(IBCPOL)),$G(IBJMSG)="" D S IBJAB(IBCPOL)=""
42 . S IBEVDT=$E(+$G(^DGCR(399,+IBIFN,"U")),1,7),IBDT=-IBEVDT-.01
43 . S IBDT=$O(^IBA(355.4,"APY",IBCPOL,IBDT))
44 . I 'IBDT!($$FMDIFF^XLFDT(IBEVDT,-IBDT)>365) S IBJMSG="No Annual Benefits cover begin date of bill ("_$$DATE^IBJU1(IBEVDT)_")." Q
45 . S IBYR=-IBDT,IBCAB=$O(^IBA(355.4,"APY",IBCPOL,IBDT,""))
46 . I 'IBCAB S IBJMSG="No Annual Benefits record found."
47IA1 I '$G(IBIFN) D PRTCL^IBJU1("IBJT SHORT MENU")
48 I $G(IBJMSG)'="" K ^TMP("IBCNSA",$J) D BLD(IBJMSG) K VALMHDR Q
49 D INIT^IBCNSA I '$D(VALMQUIT) K VALMHDR
50 Q
51EXITA D EXIT^IBCNSA K IBJAB,^TMP("IBCNSA",$J) Q
52HELPA D HELP^IBCNSA Q
53 ;
54AB(REDISP) ; -- IBJT NS VIEW AN BEN SCREEN ACTION: patient policy annual benefits for year which contains the bill's
55 ; Statement From Date, once the annual benefits of the policy that covers the bill's year has been
56 ; displayed, the user will be allowed to pick other AB years for the policy
57 ; user can select policy if more than one on bill, REDISP set if screen to be rebuilt for different policy
58 ;
59 I '$G(REDISP) N IBEVDT,IBDT,IBYR,IBCAB,IBX,IBVIEW,IBCHANGE,IBCNS,IBCPOL,IBPPOL,IBCGN,IBYE,IBJPOL,IBI,IBDUZ,IBDA,IBCNT,OFFSET,START
60 I '$G(IBIFN)!'$G(DFN) G ABQ
61 D FULL^VALM1
62 S IBX=$$PST^IBJTU31(IBIFN) I 'IBX S VALMBCK="R" G ABQ
63 S IBJPOL=IBX
64 I '$G(REDISP) D EN^VALM("IBJT NS VIEW AN BEN") G ABQ
65 D INITA S VALMBCK="R"
66ABQ Q
67 ;
68 ;
69BLD(MSG) D KILL^VALM10(),SET^IBCNSP(1,1,""),SET^IBCNSP(2,1,MSG) Q
70PST(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
Note: See TracBrowser for help on using the repository browser.