1 | IBCNSM5 ;ALB/NLR - INSURANCE MANAGEMENT WORKSHEET ; 23-JUL-93
|
---|
2 | ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | % G EN^IBCNSM
|
---|
6 | ;
|
---|
7 | WPPC ; -- print insurance management worksheet, insurance coverage
|
---|
8 | ;
|
---|
9 | I '$G(IBCPOL) D G WPPCQ
|
---|
10 | .D FULL^VALM1
|
---|
11 | .W !!,"There is no plan associated with this policy!"
|
---|
12 | .W !!,"Please use the action 'Change Plan Info', which will create a plan"
|
---|
13 | .W !,"for the policy."
|
---|
14 | .N DIR,DTOUT,DUOUT,DIROUT S DIR(0)="E" W ! D ^DIR
|
---|
15 | ;
|
---|
16 | N IBCAB,IBPIB1,IBPAG,IBQUIT,IBW
|
---|
17 | S IBPIB1=1,IBW=1
|
---|
18 | D GETEN1 I ('($G(IBW)))!(IBYR<(DT-10000)&($G(IBLINE)))!($D(DIRUT)) G WPPCQ
|
---|
19 | D DEV
|
---|
20 | I $G(IBQUIT) G WPPCQ
|
---|
21 | DQ ;
|
---|
22 | S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1)
|
---|
23 | D PR
|
---|
24 | D:IBCY GETEN2
|
---|
25 | D:IBYR&IBCY PR
|
---|
26 | I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
|
---|
27 | WPPCQ I $D(ZTQUEUED) S ZTREQ="@" Q
|
---|
28 | D ^%ZISC
|
---|
29 | K IBCPOL,IBYR,IBPIB1,IBW
|
---|
30 | Q
|
---|
31 | PR ; -- set variables needed for file navigation, print insurance worksheet or coverage
|
---|
32 | ;
|
---|
33 | D SETVAR
|
---|
34 | D PRINT
|
---|
35 | PRQ Q
|
---|
36 | ;
|
---|
37 | GETEN1 ; -- find IEN of most recent policy
|
---|
38 | ;
|
---|
39 | ;N IBCDFND,IBCDFND1,IBCDFND2
|
---|
40 | ;I $G(IBYR)="" S IBYR=DT
|
---|
41 | ;I '$G(IBCPOL) S IBCPOL=$P($G(^IBA(355.4,$G(DA),0)),"^",2)
|
---|
42 | ;I 'IBCPOL G GETEN1Q
|
---|
43 | S IBYR=$O(^IBA(355.4,"APY",IBCPOL,-(DT+.0001))) I IBYR S:IBYR<0 IBYR=-IBYR
|
---|
44 | I ('IBYR),'IBLINE D ASK I ($D(DIRUT))!('($G(IBW))) G GETEN1Q
|
---|
45 | I $G(IBLINE)&(('IBYR)!(IBYR<(DT-10000))) S IBYR=DT
|
---|
46 | S IBCAB="" S IBCAB=$O(^IBA(355.4,"APY",IBCPOL,-IBYR,IBCAB))
|
---|
47 | ;W !!,"DATE OF PREVIOUS ENTRY IS "_$$DAT1^IBOUTL(IBYR),!! H 3
|
---|
48 | ;I IBYR<(DT-10000),IBLINE S IBYR=DT
|
---|
49 | ;I IBYR<(DT-10000),IBLINE W !!,"MOST RECENT ENTRY IS "_$$DAT1^IBOUTL(IBYR)_". ENTRY CANNOT BE MORE THAN A YEAR OLD.",!!,"YOU MAY PRINT ENTRY UNDER 'PC'.",!! H 4
|
---|
50 | GETEN1Q Q
|
---|
51 | ;
|
---|
52 | SETVAR ; -- set variables needed for file navigation
|
---|
53 | ;
|
---|
54 | S IBCDFND=$G(^DPT(DFN,.312,$P(IBPPOL,"^",4),0)),IBCNS=+IBCDFND
|
---|
55 | S IBCDFND1=$G(^DPT(DFN,.312,$P(IBPPOL,"^",4),1))
|
---|
56 | S IBCDFND2=$G(^DPT(DFN,.312,$P(IBPPOL,"^",4),2))
|
---|
57 | S IBCDFNDA=$G(^DIC(36,+IBCDFND,.11))
|
---|
58 | S IBCDFNDB=$G(^DIC(36,+IBCDFND,.13))
|
---|
59 | S IBCPOL=+$P(IBCDFND,"^",18),IBCNS=+IBCDFND,IBCDFN=$P(IBPPOL,"^",4)
|
---|
60 | S IBCPOLD=$G(^IBA(355.3,+$P(IBCDFND,"^",18),0))
|
---|
61 | S FILE="^DPT("_DFN_",.312,"
|
---|
62 | S IBCBU=$O(^IBA(355.5,"APPY",DFN,IBCPOL,-IBYR,IBCDFN,0))
|
---|
63 | S IBCBUD=$G(^IBA(355.5,+IBCBU,0))
|
---|
64 | S IBCBUD1=$G(^IBA(355.5,+IBCBU,1))
|
---|
65 | S IBCGN=$$GRP^IBCNS(IBCPOL)
|
---|
66 | S IBPAT=1
|
---|
67 | S IBCABD=$G(^IBA(355.4,+IBCAB,0))
|
---|
68 | S IBCABD2=$G(^IBA(355.4,+IBCAB,2))
|
---|
69 | S IBCABD3=$G(^IBA(355.4,+IBCAB,3))
|
---|
70 | S IBCABD4=$G(^IBA(355.4,+IBCAB,4))
|
---|
71 | S IBCABD5=$G(^IBA(355.4,+IBCAB,5))
|
---|
72 | Q
|
---|
73 | ;
|
---|
74 | DEV ; -- ask for device
|
---|
75 | ;
|
---|
76 | W !!,"*** You will need a 132 column printer for this report. ***",!
|
---|
77 | S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 G R1Q
|
---|
78 | I $D(IO("Q")) K IO("Q") S IBQUIT=1,ZTRTN="DQ^IBCNSM5",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="INSURANCE MANAGEMENT WORKSHEET" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q
|
---|
79 | I $E(IOST,1,2)="C-" D FULL^VALM1
|
---|
80 | U IO
|
---|
81 | R1Q Q
|
---|
82 | ;
|
---|
83 | PRINT ; -- print insurance management worksheet/insurance coverage
|
---|
84 | ;
|
---|
85 | D PID^VADPT
|
---|
86 | D HDR
|
---|
87 | D BL1^IBCNSM6,BL2^IBCNSM7,BL3^IBCNSM8,BL4^IBCNSM8,BL5^IBCNSM9,BL6^IBCNSM9,BL7^IBCNSM9
|
---|
88 | Q
|
---|
89 | ;
|
---|
90 | HDR ; -- print header
|
---|
91 | ;
|
---|
92 | I $E(IOST,1,2)["C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
|
---|
93 | W:$E(IOST,1,2)["C-"!($G(IBPAG)) @IOF
|
---|
94 | S IBPAG=$G(IBPAG)+1
|
---|
95 | W !,$S($G(IBLINE):"INSURANCE MANAGEMENT WORKSHEET",1:"INSURANCE COVERAGE FOR "_$S($G(IBPIB1):"CURRENT ENTRY",1:"NEXT-MOST-CURRENT ENTRY")),?(IOM-30),IBHDT," PAGE ",IBPAG
|
---|
96 | W !,$TR($J(" ",IOM)," ","_")
|
---|
97 | D DEM^VADPT
|
---|
98 | W !!,VADM(1),?34,"PT ID: "_VA("PID"),?79,"DOB: "_$P(VADM(3),"^",2)
|
---|
99 | W !,$E($P($G(^DIC(36,+IBCDFND,0)),"^"),1,28),?31," GROUP #: ",$$DOL^IBCNSM6(355.3,.04,$P(IBCPOLD,"^",4),$G(IBLINE))
|
---|
100 | W ?74,"For YEAR: "_$S($G(IBCAB):$$DAT1^IBOUTL(IBYR),1:"______________")
|
---|
101 | W !?30,"Ins. Type: ",$$DOL^IBCNSM6(355.1,.01,$P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),"^"),$G(IBLINE))
|
---|
102 | Q
|
---|
103 | ;
|
---|
104 | GETEN2 ; -- get IEN of next-to-most-recent entry (Print Coverage)
|
---|
105 | ;
|
---|
106 | S IBYR=$O(^IBA(355.4,"APY",IBCPOL,-IBYR)) I 'IBYR G PR1Q
|
---|
107 | S:IBYR<0 IBYR=-IBYR
|
---|
108 | S IBCAB="" S IBCAB=$O(^IBA(355.4,"APY",IBCPOL,-IBYR,IBCAB))
|
---|
109 | S IBPIB1=0
|
---|
110 | PR1Q Q
|
---|
111 | ;
|
---|
112 | ASK ; -- if Print Coverage and no benefit years for selected policy, ask if user wants worksheet
|
---|
113 | ;
|
---|
114 | W !
|
---|
115 | S DIR(0)="YO",DIR("A")="No Benefit Years on File. Do you want to fill out a worksheet",DIR("B")="No"
|
---|
116 | W !
|
---|
117 | D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 G ASKQ
|
---|
118 | I Y S IBW=1,IBLINE=1,IBCY=0 G ASKQ
|
---|
119 | S IBW=0 D PAUSE^VALM1
|
---|
120 | ASKQ ;
|
---|
121 | Q
|
---|