close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSM1.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
1IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 22-OCT-92
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28,56**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G EN^IBCNSM
6 ;
7VP ; -- View Patient Policy Info
8 D FULL^VALM1
9 N I,J,IBXX,VALMY
10 D EN^VALM2($G(XQORNOD(0)))
11 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D ;W !,"Entry ",X,"Selected" D
12 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
13 .Q:IBPPOL=""
14 .D EN^VALM("IBCNS EXPANDED POLICY")
15 .Q
16 I '$G(IBFASTXT) D BLD^IBCNSM
17 S VALMBCK="R" Q
18 ;
19AB ; -- Edit Annual Benefits
20 D FULL^VALM1
21 N I,J,IBXX,VALMY
22 D EN^VALM2($G(XQORNOD(0)))
23 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
24 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
25 .Q:IBPPOL=""
26 .S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
27 .D FULL^VALM1
28 .D EN^VALM("IBCNS ANNUAL BENEFITS")
29 .Q
30 S VALMBCK="R" Q
31 ;
32UP ; -- Print new, not verified insurance
33 ;
34 N I,J,IBXX,IBCNS,VALMY
35 D EN^VALM2($G(XQORNOD(0)))
36 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) W !,IBXX,! H 2 Q:'IBXX D
37 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
38 .Q:IBPPOL=""
39 .S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
40 .S INSCO=^DIC(36,IBCNS,0)
41 .W !!,$P(INSCO,"^"),!! H 2
42 .W !!,$P(IBPPOL,"^",4),!! H 2
43 .Q
44 D FULL^VALM1
45 W !!,"REPORT OF NEW NOT VERIFIED INSURANCE",!! H 2
46 S VALMBCK="R" Q
47 ;
48PC ; -- Print Patient Insurance info
49 ;N IBLINE,IBCY,IBWP
50 N IBWP
51 ;
52PCWP ; -- Print Insurance Coverage, Worksheet
53 ;
54 N I,J,IBXX,IBLINE,IBCY,VALMY
55 D EN^VALM2($G(XQORNOD(0)))
56 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
57 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
58 .Q:IBPPOL=""
59 .S IBCPOL=$P(IBPPOL,"^",22)
60 .S IBLINE=$S($G(IBWP):1,1:0)
61 .S IBCY=$S($G(IBWP):0,1:1)
62 .D WPPC^IBCNSM5
63 .Q
64 S VALMBCK="R" Q
65 ;
66WP ; -- Print Worksheet
67 N IBWP
68 S IBWP=1
69 D PCWP
70 S VALMBCK="R" Q
71 ;
72DP ; -- Delete insurance policy
73 D FULL^VALM1
74 I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D SORRY^IBTRE1 G DPQ
75 N I,J,IBXX,DIR,DIRUT,IBBCNT,BLD,IBCOVP,IBFNOPOL,VALMY
76 D EN^VALM2($G(XQORNOD(0)))
77 S IBCOVP=$P($G(^DPT(DFN,.31)),"^",11)
78 ; if no policies, set ibfnopol flag to prevent call to pause^valm1
79 ; at label dpq
80 I '$D(VALMY) S IBFNOPOL=1
81 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
82 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
83 .; do some error checking here
84 .I $$DELP^IBCNSU(DFN,$P(IBPPOL,"^",5)) D Q
85 ..W !,"You can't delete this policy, there are bills associated with it."
86 ..W ! S J=0 F S J=$O(^DGCR(399,"AE",DFN,$P(IBPPOL,"^",5),J)) Q:'J I $P(^DGCR(399,J,"S"),"^",17)="" W $P(^DGCR(399,J,0),"^")_" " S IBBCNT=$G(IBBCNT)+1 W:'(IBBCNT#8) !
87 ..K IBBCNT
88 ..Q
89 .;
90 .; - warn if there are associated Insurance reviews
91 .I $$IR^IBCNSJ21(DFN,+$P(IBPPOL,"^",4)) W !,*7,"Please note that there are Insurance Reviews associated with this policy!!",!
92 .;
93 .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete policy #"_IBXX
94 .D ^DIR K DIR I Y'=1 W !,"Policy #",IBXX," not Deleted!" Q
95 .S IBCDFN=$P(IBPPOL,"^",4)
96 .D DP1
97 .Q
98DPQ D COVERED^IBCNSM31(DFN,$G(IBCOVP))
99 I '$G(IBFNOPOL) D PAUSE^VALM1
100 I $G(BLD) D BLD^IBCNSM
101 S VALMBCK="R" Q
102 ;
103DP1 ; -- actual deletion
104 N DA,DIC,DIK,IBJJ,IBJJJ,IBBU,IBPLAN,IBCPOLD
105 S IBPLAN=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18),IBCPOLD=$G(^IBA(355.3,+IBPLAN,0))
106 ;
107 ; -- delete riders
108 S IBJJ=0 F S IBJJ=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBJJ)) Q:'IBJJ D
109 .S IBJJJ=0 F S IBJJJ=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBJJ,IBJJJ)) Q:'IBJJJ S DA=IBJJJ,DIK="^IBA(355.7,",DIDEL=355.7 D ^DIK
110 ;
111 ; -- delete benefits used
112 I IBPLAN D BU^IBCNSJ21 S IBJJ="" F S IBJJ=$O(IBBU(IBJJ)) Q:IBJJ="" D DBU^IBCNSJ(IBBU(IBJJ))
113 ;
114 ; -- remove pointers from Insurance reviews
115 S IBJJ=0 F S IBJJ=$O(^IBT(356.2,"D",DFN,IBJJ)) Q:'IBJJ I $P($G(^IBT(356.2,IBJJ,1)),"^",5)=IBCDFN S $P(^(1),"^",5)=""
116 ;
117 ; -- if individual policy, and is right patient, delete HIP
118 S BLD=1
119 I '$P(IBCPOLD,"^",2),DFN=$P(IBCPOLD,"^",10) D DEL^IBCNSJ(IBPLAN)
120 ;
121 ; -- delete entry in patient file
122 S DA=IBCDFN,DA(1)=DFN,DIK="^DPT("_DFN_",.312," D ^DIK
123 W:$G(IBXX) !,"Entry ",$G(IBXX)," Deleted"
124 Q
Note: See TracBrowser for help on using the repository browser.