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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1IBCNSC ;ALB/NLR - INSURANCE COMPANY EDIT ;6/1/05 9:42am
2 ;;2.0;INTEGRATED BILLING;**46,137,184,276,320,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;also used for IA #4694
6 ;
7EN ; -- main entry point for IBCNS INSURANCE COMPANY, IBCNS VIEW INS CO
8 NEW IB1ST
9 K IBFASTXT,VALMQUIT,VALMEVL,XQORS,^TMP("XQORS",$J),IBCNS
10 S IBCHANGE="OKAY"
11 I '$G(IBVIEW) D EN^VALM("IBCNS INSURANCE COMPANY") G ENQ
12 D EN^VALM("IBCNS VIEW INS CO")
13ENQ Q
14 ;
15HDR ; -- header code
16 S VALMHDR(1)="Insurance Company Information for: "_$E($P(^DIC(36,IBCNS,0),"^"),1,30)
17 S VALMHDR(2)="Type of Company: "_$E($P($G(^IBE(355.2,+$P($G(^DIC(36,+IBCNS,0)),"^",13),0)),"^"),1,20)_" Currently "_$S(+($P($G(^DIC(36,+IBCNS,0)),"^",5)):"Inactive",1:"Active")
18 Q
19 ;
20INIT ; -- init variables and list array
21 K VALMQUIT
22 S VALMCNT=0,VALMBG=1
23 I '$D(IBCNS) D INSCO Q:$D(VALMQUIT)
24 D BLD,HDR
25 Q
26BLD ; -- list builder
27 NEW BLNKI
28 K ^TMP("IBCNSC",$J)
29 D KILL^VALM10() ; delete all video attributes
30 F BLNKI=1:1:54 D BLANK(.BLNKI) ; 54 blank lines to start with
31 D PARAM^IBCNSC01 ; billing parameters
32 D MAIN^IBCNSC01 ; main mailing address
33 D CLAIMS1^IBCNSC0 ; inpatient claims office
34 D CLAIMS2^IBCNSC0 ; outpatient claims office
35 D PRESCR^IBCNSC1 ; prescription claims office
36 D APPEALS ; appeals office
37 D INQUIRY ; inquiry office
38 D DISP^IBCNSC02 ; parent/child associations (ESG 11/3/05)
39 D PROVID^IBCNSC1 ; provider IDs
40 D PAYER^IBCNSC01 ; payer/payer apps (ESG 7/29/02 IIV project)
41 D REMARKS^IBCNSC01 ; remarks
42 D SYN^IBCNSC01 ; synonyms
43 S VALMCNT=+$O(^TMP("IBCNSC",$J,""),-1)
44 Q
45 ;
46APPEALS ;
47 N OFFSET,START,IBCNS14,IBADD
48 S IBCNS14=$$ADDRESS^IBCNSC0(IBCNS,.14,7)
49 S START=48,OFFSET=2
50 D SET^IBCNSP(START,OFFSET+25," Appeals Office Information ",IORVON,IORVOFF)
51 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS14,"^",7),0)),"^",1))
52 D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS14,"^",1))
53 D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS14,"^",2))
54 N OFFSET S OFFSET=45
55 D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS14,"^",3)) S IBADD=1
56 D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS14,"^",4),1,15)_$S($P(IBCNS14,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS14,"^",5),0)),"^",2)_" "_$E($P(IBCNS14,"^",6),1,5))
57 D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS14,"^",8))
58 D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS14,"^",9))
59 Q
60 ;
61INQUIRY ;
62 ;
63 N OFFSET,START,IBCNS15,IBADD
64 S IBCNS15=$$ADDRESS^IBCNSC0(IBCNS,.15,8)
65 S START=55,OFFSET=2
66 D SET^IBCNSP(START,OFFSET+25," Inquiry Office Information ",IORVON,IORVOFF)
67 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS15,"^",7),0)),"^",1))
68 D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS15,"^"))
69 D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS15,"^",2))
70 N OFFSET S OFFSET=45
71 D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS15,"^",3)) S IBADD=1
72 D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS15,"^",4),1,15)_$S($P(IBCNS15,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS15,"^",5),0)),"^",2)_" "_$E($P(IBCNS15,"^",6),1,5))
73 D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS15,"^",8))
74 D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS15,"^",9))
75 Q
76 ;
77HELP ; -- help code
78 S X="?" D DISP^XQORM1 W !!
79 Q
80 ;
81EXIT ; -- exit code
82 K VALMQUIT,IBCNS,IBCHANGE,IBFASTXT
83 D CLEAN^VALM10
84 Q
85 ;
86INSCO ; -- select insurance company
87 NEW DLAYGO,DIC,X,Y,DTOUT,DUOUT
88 I '$D(IBCNS) D G:$D(VALMQUIT) INSCOQ
89 .S DIC="^DIC(36,",DIC(0)="AEQMZ",DIC("S")="I '$G(^(5))"
90 .I '$G(IBVIEW) S DLAYGO=36,DIC(0)=DIC(0)_"L"
91 .D ^DIC K DIC
92 .S IBCNS=+Y
93 I $G(IBCNS)<1 K IBCNS S VALMQUIT="" G INSCOQ
94INSCOQ ;
95 K DIC
96 Q
97 ;
98BLANK(LINE) ; -- Build blank line
99 D SET^VALM10(.LINE,$J("",80))
100 Q
101 ;
102EDIKEY() ; input transform code to determine if user is allowed to edit
103 ; certain fields in the insurance company file
104 NEW OK S OK=0
105 I $$KCHK^XUSRB("IB EDI INSURANCE EDIT") S OK=1 G EDIKEYX
106 D EN^DDIOL("You must hold the IB EDI INSURANCE EDIT security key to edit this field.",,"!!")
107 D EN^DDIOL("",,"!!?5")
108EDIKEYX ;
109 Q OK
110 ;
111DUPQUAL(IBCNS,QUAL,FIELD) ; input transform to make sure that the sam qualifier is not used twice for
112 ; payer secondary IDs. There are two sets of fields in file 36 that can not be duplicated.
113 ; 6.01 EDI INST SECONDARY ID QUAL(1) can not be the same as 6.03 EDI INST SECONDARY ID QUAL(2)
114 ; 6.05 EDI PROF SECONDARY ID QUAL(1) can not be the same as 6.07 EDI PROF SECONDARY ID QUAL(2)
115 ;
116 ; Input:
117 ; IBCNS is the insurance company internal number
118 ; QUAL is the internal code of the value being input.
119 ; FIELD is the field it is being compare with.
120 ;
121 ; Returns:
122 ; TRUE/1 if they are the same (duplicate)
123 ; FALSE/0 if they are not
124 ;
125 Q:$G(QUAL)="" 0 ; should not happen because this is invoked as an input transform
126 Q:'+$G(IBCNS) 1 ; stop from editing through fileman
127 N DUP
128 S DUP=$$GET1^DIQ(36,+$G(IBCNS)_",",+$G(FIELD),"I")
129 D CLEAN^DILF
130 Q QUAL=DUP
Note: See TracBrowser for help on using the repository browser.