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

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

initial load of WorldVistAEHR
File size: 5.9 KB
Line 
1IBCNSP0 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993
2 ;;2.0;INTEGRATED BILLING;**28,43,52,85,93,103,137,229,251,363,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6CONTACT ; -- Insurance Contact Information
7 N OFFSET,START
8 ;
9 ; The start of this section is designed to start on the same line
10 ; as the User Information section (see VER^IBCNSP01).
11 ;
12 S START=$O(^TMP("IBCNSVP",$J,""),-1)-8
13 S IB1ST("CONTACT")=START
14 S OFFSET=42
15 N IBTRC,IBTRCD,IBTCOD
16 S IBTCOD=$O(^IBE(356.11,"ACODE",85,0))
17 ;
18 S IBTRC=0,IBTRCD=""
19 F S IBTRC=$O(^IBT(356.2,"D",DFN,IBTRC)) Q:'IBTRC D
20 .Q:$P($G(^IBT(356.2,+IBTRC,1)),"^",5)'=IBCDFN ; must be same policy
21 .Q:$P($G(^IBT(356.2,+IBTRC,0)),"^",4)'=IBTCOD ; must be ins. ver. type
22 .S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
23 ;
24 D SET(START,OFFSET," Insurance Contact (last) ",IORVON,IORVOFF)
25 D SET(START+1,OFFSET," Person Contacted: "_$$EXPAND^IBTRE(356.2,.06,$P(IBTRCD,"^",6)))
26 D SET(START+2,OFFSET,"Method of Contact: "_$$EXPAND^IBTRE(356.2,.17,$P(IBTRCD,"^",17)))
27 D SET(START+3,OFFSET," Contact's Phone: "_$$EXPAND^IBTRE(356.2,.07,$P(IBTRCD,"^",7)))
28 D SET(START+4,OFFSET," Call Ref. No.: "_$$EXPAND^IBTRE(356.2,.09,$P(IBTRCD,"^",9)))
29 D SET(START+5,OFFSET," Contact Date: "_$$EXPAND^IBTRE(356.2,.01,$P(IBTRCD,"^")))
30 ; no blank lines here because the User Information section is on the
31 ; left and it is bigger than this section
32 Q
33 ;
34POLICY ; -- Policy Region
35 ; -- if pointer to policy file exists get data from policy file
36 N OFFSET,START,IBP,IBX,IBPLNID,IBPLNNM,IBPLNNA,IBPLNLA
37 S (IBPLNID,IBPLNNM,IBPLNNA,IBPLNLA)=""
38 S START=1,OFFSET=2
39 D GPLAN(+IBCPOLD2)
40 D SET(START,OFFSET," Plan Information ",IORVON,IORVOFF)
41 D SET(START+1,OFFSET," Is Group Plan: "_$S($P(IBCPOLD,"^",2)=1:"YES",1:"NO"))
42 D SET(START+2,OFFSET," Group Name: "_$P(IBCPOLD,"^",3))
43 D SET(START+3,OFFSET," Group Number: "_$P(IBCPOLD,"^",4))
44 D SET(START+4,OFFSET," BIN: "_$P(IBCPOLD2,"^",2)) ;;Daou/EEN
45 D SET(START+5,OFFSET," PCN: "_$P(IBCPOLD2,"^",3)) ;;04/09/04
46 D SET(START+6,OFFSET," Type of Plan: "_$E($P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),"^"),1,23))
47 S IBX=7
48 I $P(IBCPOLD,U,14)]"" D
49 . D SET(START+IBX,OFFSET," Plan Category: "_$$EXPAND^IBTRE(355.3,.14,$P(IBCPOLD,"^",14))) S IBX=IBX+1
50 I $P(IBCPOLD,U,15)]"" D
51 . D SET(START+IBX,OFFSET," Electronic Type: "_$$EXPAND^IBTRE(355.3,.15,$P(IBCPOLD,"^",15))) S IBX=IBX+1
52 D SET(START+IBX,OFFSET," Plan Filing TF: "_$P(IBCPOLD,"^",13)) S IBX=IBX+1
53 ;
54 D SET(START+IBX,OFFSET," ePharmacy Plan ID: "_IBPLNID) S IBX=IBX+1
55 D SET(START+IBX,OFFSET," ePharmacy Plan Name: "_IBPLNNM) S IBX=IBX+1
56 D SET(START+IBX,OFFSET," ePharmacy Natl Status: "_IBPLNNA) S IBX=IBX+1
57 D SET(START+IBX,OFFSET," ePharmacy Local Status: "_IBPLNLA) S IBX=IBX+1
58 ;
59 ; -- in case pointer is missing
60 I '$G(^IBA(355.3,+$P(IBCDFND,"^",18),0)) D
61 .D SET(START+1,OFFSET,"Insurance Number: "_$P(IBCDFND,"^",2))
62 .D SET(START+2,OFFSET," Group Name: "_$P(IBCDFND,"^",15))
63 .D SET(START+3,OFFSET," Group Number: "_$P(IBCDFND,"^",3))
64 .Q
65 Q
66 ;
67INS ; -- Insurance Co. Region
68 N OFFSET,START,IBADD,IBCDFNDA,IBCDFNDB
69 S START=1,OFFSET=45
70 D SET(START,OFFSET," Insurance Company ",IORVON,IORVOFF)
71 D SET(START+1,OFFSET," Company: "_$P($G(^DIC(36,+IBCDFND,0)),"^"))
72 S IBCDFNDA=$G(^DIC(36,+IBCDFND,.11)),IBCDFNDB=$G(^(.13))
73 G:IBCDFNDA="" INSQ
74 D SET(START+2,OFFSET," Street: "_$P(IBCDFNDA,"^")) S IBADD=1
75 I $P(IBCDFNDA,"^",2)'="" D SET(START+3,OFFSET," Street 2: "_$P(IBCDFNDA,"^",2)) S IBADD=2
76 I $P(IBCDFNDA,"^",3)'="" D SET(START+4,OFFSET," Street 3: "_$P(IBCDFNDA,"^",3)) S IBADD=3
77 D SET(START+2+IBADD,OFFSET,"City/State: "_$E($P(IBCDFNDA,"^",4),1,15)_$S($P(IBCDFNDA,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCDFNDA,"^",5),0)),"^",2)_" "_$E($P(IBCDFNDA,"^",6),1,5))
78 D SET(START+3+IBADD,OFFSET,"Billing Ph: "_$P(IBCDFNDB,"^",2))
79 D SET(START+4+IBADD,OFFSET,"Precert Ph: "_$$PHONE^IBCNSC01(IBCDFNDB))
80 ;
81INSQ Q
82 ;
83SPON ; -- Sponsor (Insured Person) Region
84 N IBC3,IBZIP,START,OFFSET,IBA,DA,DR,DIC,DIQ
85 S IBC3=$G(^DPT(DFN,.312,IBCDFN,3))
86 S DA=+$P(IBC3,"^",2),DR=.01,DIQ(0)="E",DIC="^DIC(23,",DIQ="IBA" D EN^DIQ1
87 S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=4
88 D SET(START,OFFSET," Insured Person's Information (use Subscriber Update Action) ",IORVON,IORVOFF)
89 D SET(START+1,OFFSET," Insured's DOB: "_$$DAT3^IBOUTL($P(IBC3,"^")))
90 D SET(START+2,OFFSET," Insured's Sex: "_$$EXTERNAL^DILFD(2.312,3.12,,$P(IBC3,U,12)))
91 D SET(START+3,OFFSET," Insured's Branch: "_$G(IBA(23,DA,.01,"E")))
92 D SET(START+4,OFFSET," Insured's Rank: "_$P(IBC3,"^",3))
93 ;
94 S OFFSET=43
95 S Y=$P(IBC3,"^",10) D ZIPOUT^VAFADDR S IBZIP=Y
96 D SET(START+1,OFFSET," Str 1: "_$P(IBC3,"^",6))
97 D SET(START+2,OFFSET," Str 2: "_$P(IBC3,"^",7))
98 D SET(START+3,OFFSET," City: "_$P(IBC3,"^",8))
99 D SET(START+4,OFFSET,"St/Zip: "_$P($G(^DIC(5,+$P(IBC3,"^",9),0)),"^",2)_" "_IBZIP)
100 D SET(START+5,OFFSET," Phone: "_$P(IBC3,"^",11))
101 ;
102 ; blank lines at end of section
103 D SET(START+6,2," ")
104 D SET(START+7,2," ")
105 Q
106 ;
107BLANK(LINE) ; -- Build blank line
108 D SET^VALM10(.LINE,$J("",80))
109 Q
110 ;
111SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array
112 D:'$D(@VALMAR@(LINE,0)) BLANK(.LINE)
113 D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT)))
114 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF))
115 W:'(LINE#5) "."
116 Q
117 ;
118GPLAN(IBPLDA) ; get data from PLAN file (#366.03) related to the
119 ; GROUP INSURANCE PLAN file (#355.3) and the INSURANCE COMPANY file (#36)
120 ; that is associated with the PATIENT
121 ; input - IBPLDA - ien of the PLAN file (#366.03)
122 N IBPLN0,IBAIEN,IBAPIEN,IBAP0
123 S IBPLN0=$G(^IBCNR(366.03,IBPLDA,0)) ;; Q:'$P(IBPLN0,"^",3) ;quit if payer not defined
124 S IBPLNID=$P(IBPLN0,"^"),IBPLNNM=$P(IBPLN0,"^",2)
125 S IBAIEN=$O(^IBCNR(366.13,"B","E-PHARM","")) Q:'IBAIEN
126 S IBAPIEN=$O(^IBCNR(366.03,IBPLDA,3,"B",IBAIEN,"")) Q:'IBAPIEN
127 S IBAP0=$G(^IBCNR(366.03,IBPLDA,3,IBAPIEN,0))
128 S IBPLNNA=$S($P(IBAP0,"^",2)=0:"NOT ACTIVE",1:"ACTIVE")
129 S IBPLNLA=$S($P(IBAP0,"^",3)=0:"NOT ACTIVE",1:"ACTIVE")
130 Q
131 ;
132 ;IBCNSP0
Note: See TracBrowser for help on using the repository browser.