source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSM5.m@ 1203

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1IBCNSM5 ;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 ;
7WPPC ; -- 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
21DQ ;
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
27WPPCQ I $D(ZTQUEUED) S ZTREQ="@" Q
28 D ^%ZISC
29 K IBCPOL,IBYR,IBPIB1,IBW
30 Q
31PR ; -- set variables needed for file navigation, print insurance worksheet or coverage
32 ;
33 D SETVAR
34 D PRINT
35PRQ Q
36 ;
37GETEN1 ; -- 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
50GETEN1Q Q
51 ;
52SETVAR ; -- 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 ;
74DEV ; -- 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
81R1Q Q
82 ;
83PRINT ; -- 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 ;
90HDR ; -- 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 ;
104GETEN2 ; -- 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
110PR1Q Q
111 ;
112ASK ; -- 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
120ASKQ ;
121 Q
Note: See TracBrowser for help on using the repository browser.