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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1IBCNERPC ;DAOU/RO - IIV PAYER LINK REPORT COMPILE ;AUG-2003
2 ;;2.0;INTEGRATED BILLING;**184,252,271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; IIV - Insurance Identification and Verification
6 ;
7 ; Input vars from IBCNERPB:
8 ; IBCNESPC("REP")=1 for Payer List report, 2 for Company List
9 ; IBCNESPC("PTYPE")=Payer type (1-no active ins linked, 2-at least 1 ins linked, 3-All Payers)
10 ; IBCNESPC("PSORT")=Primary Sort for Payer report
11 ; IBCNESPC("PDET")=Ins detail on payer report (1-include list of ins,2-do not list)
12 ;
13 ; IBCNESPC("ITYPE")=Ins Company type (1-no payer link, 2-linked to payer, 3-All ins companies)
14 ; IBCNESPC("ISORT")=Primary Sort for Payer Insurance report
15 ; IBCNESPC("IMAT")=Partial matching Ins carriers
16 ;
17 ; Output vars used by IBCNERPC:
18 ;
19 ; IBCNERTN="IBCNERPB"
20 ; SORT1=depends on sorting option chosen
21 ; SORT2=Payer Name (Report by Payer) or Ins Company Name (if report is Insurance)
22 ; ^TMP($J,IBCNERTN,SORT1,SORT2,CNT)
23 ; CNT=Seq ct
24 ; ^TMP($J,IBCNERTN,SORT1,SORT2,CNT,1)
25 ;
26 ; Must call at EN
27 Q
28 ;
29EN(IBCNERTN,IBCNESPC) ; Entry
30 ; Init
31 N IBTYP,IBCT,IBCTX
32 ;
33 N IBDET,IBSRT,IBPY,IBVAID,IBPROF,IBINST,IBNAACT,IBLOACT,IBINS,IBINST
34 N IBINSN,IBAPP,IBPYR,SORT1,SORT2,IBSRT,IBMAT,IBPPYR,IBREP
35 ;
36 I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
37 ;
38 ; Temp ct
39 S IBCT=0
40 ;
41 ; Kill scratch globals
42 K ^TMP($J,IBCNERTN)
43 ;
44 ;
45 S IBREP=$G(IBCNESPC("REP"))
46 S IBDET=$G(IBCNESPC("PDET"))
47 S IBTYP=$G(IBCNESPC("PTYPE"))
48 S IBSRT=$G(IBCNESPC("PSORT"))
49 S IBPPYR=$G(IBCNESPC("PPYR"))
50 ;
51 ; Ins Report
52 I IBREP=2 G INS
53 ;
54 ; Loop thru the IIV payer File (#365.12)
55 S IBPY=0,SORT1=""
56 F S IBPY=$O(^IBE(365.12,IBPY)) Q:'IBPY D Q:$G(ZTSTOP)
57 . I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 Q
58 . ; Payer name from Payer File (#365.12)
59 . S IBPYR=$P($G(^IBE(365.12,IBPY,0)),U) I IBSRT=1 S SORT1=IBPYR
60 . S SORT2=IBPYR
61 . I IBPYR=""!(IBPYR="~NO PAYER")!($$PYRAPP^IBCNEUT5("IIV",IBPY)="") Q
62 . I IBPPYR'="",IBPY'=$P(IBPPYR,U) Q
63 . ; get VA national ID
64 . S IBVAID=$P($G(^IBE(365.12,IBPY,0)),U,2) I IBSRT=2 S SORT1=IBVAID
65 . ; get the EDI numbers (professional and institutional)
66 . S IBPROF=$P($G(^IBE(365.12,IBPY,0)),U,5)
67 . S IBINST=$P($G(^IBE(365.12,IBPY,0)),U,6)
68 . S IBAPP=$$PYRAPP^IBCNEUT5("IIV",IBPY),(IBNAACT,IBLOACT)=0
69 . S:IBAPP'="" IBNAACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,2)
70 . S:IBAPP'="" IBLOACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,3)
71 . ; if no sort value, use 0
72 . I IBSRT=3 S SORT1=IBNAACT I SORT1="" S SORT1=0
73 . I IBSRT=4 S SORT1=IBLOACT I SORT1="" S SORT1=0
74 . I SORT1="" S SORT1=" "
75 . ; if sorting by count and detail, need to figure count first else sort will not work
76 . I IBSRT=5,IBTYP>1,IBDET=1 D S SORT1=-IBCTX
77 . . S IBCTX=0,IBINS="" F S IBINS=$O(^DIC(36,"AC",IBPY,IBINS)) Q:IBINS="" D
78 . . . S IBINSN=$G(^DIC(36,IBINS,0)),IBINSN=$P(IBINSN,U) Q:IBINSN="" S IBCTX=IBCTX+1
79 . ; search for insurance carriers for this payer
80 . S IBCT=0,IBINS="" F S IBINS=$O(^DIC(36,"AC",IBPY,IBINS)) Q:IBINS="" D
81 . . S IBINSN=$G(^DIC(36,IBINS,0)),IBINSN=$P(IBINSN,U) Q:IBINSN=""
82 . . S IBCT=IBCT+1 I IBTYP=1 Q
83 . . ; save off address and EDI#'s for Insurance carrier
84 . . I IBDET=1 S ^TMP($J,IBCNERTN,SORT1,SORT2,IBPY,IBINSN,IBINS)=$P($G(^DIC(36,IBINS,.11)),U,1,6)_U_$P($G(^DIC(36,IBINS,3)),U,2)_U_$P($G(^DIC(36,IBINS,3)),U,4)
85 . I IBTYP=1,IBCT>0 Q
86 . I IBTYP=2,IBCT=0 Q
87 . ; use reverse sort for count
88 . I IBSRT=5 S SORT1=-IBCT
89 . S ^TMP($J,IBCNERTN,SORT1,SORT2,IBPY)=IBVAID_U_IBPROF_U_IBINST_U_IBNAACT_U_IBLOACT_U_IBCT
90 G EXIT
91 ;
92INS ;
93 S IBTYP=$G(IBCNESPC("ITYPE"))
94 S IBSRT=$G(IBCNESPC("ISORT"))
95 S IBMAT=$G(IBCNESPC("IMAT"))
96 ; Loop thru the Insurance company file
97 S IBINS=0
98 F S IBINS=$O(^DIC(36,IBINS)) Q:'IBINS D Q:$G(ZTSTOP)
99 . I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 Q
100 . S (SORT1,IBPYR,IBNAACT,IBLOACT,IBPROF,IBINST,IBVAID)=""
101 . S IBINSN=$P($G(^DIC(36,IBINS,0)),U) I IBSRT=1 S SORT1=IBINSN
102 . S SORT2=IBINSN
103 . I IBINSN="" Q
104 . I IBMAT'="",'$F($$UP^XLFSTR(IBINSN),$$UP^XLFSTR(IBMAT)) Q
105 . ; get payer
106 . S IBPY=$P($G(^DIC(36,IBINS,3)),U,10)
107 . I IBTYP=1,IBPY'="" Q
108 . I IBTYP=2,IBPY="" Q
109 . I IBPY'="" D
110 . . ; Payer name from Payer File (#365.12)
111 . . S IBPYR=$P($G(^IBE(365.12,IBPY,0)),U) I IBSRT=2 S SORT1=IBPYR
112 . . ; get VA national ID
113 . . S IBVAID=$P($G(^IBE(365.12,IBPY,0)),U,2) I IBSRT=3 S SORT1=IBVAID
114 . . S IBPROF=$P($G(^IBE(365.12,IBPY,0)),U,5)
115 . . S IBINST=$P($G(^IBE(365.12,IBPY,0)),U,6)
116 . . S IBAPP=$$PYRAPP^IBCNEUT5("IIV",IBPY),(IBNAACT,IBLOACT)=0
117 . . S:IBAPP'="" IBNAACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,2)
118 . . S:IBAPP'="" IBLOACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,3)
119 . . I IBSRT=4 S SORT1=IBNAACT I SORT1="" S SORT1=0
120 . . I IBSRT=5 S SORT1=IBLOACT I SORT1="" S SORT1=0
121 . I SORT1="" S SORT1=" "
122 . S ^TMP($J,IBCNERTN,SORT1,SORT2,IBINS)=IBPYR_U_IBVAID_U_IBPROF_U_IBINST_U_IBNAACT_U_IBLOACT_U_IBCT_U_$G(^DIC(36,IBINS,.11))_U_"~"_$G(^DIC(36,IBINS,3))
123 ;
124EXIT ;
125 Q
126 ; Lines moved from IBCNERPB
127ITYPE ; Prompt to select Insurance Company type to include
128 ; Init vars
129 N DIR,X,Y,DIRUT
130 ;
131 S DIR(0)="S^1:Unlinked insurance companies;2:Linked insurance companies;3:All insurance companies"
132 S DIR("A")="Select type of insurance companies to display"
133 S DIR("B")="3"
134 S DIR("?",1)=" 1 - Only insurance companies that are not currently linked to a payer"
135 S DIR("?",2)=" 2 - Only insurance companies that are currently linked to a payer"
136 S DIR("?")=" 3 - ALL insurance companies"
137 D ^DIR K DIR
138 I $D(DIRUT) S STOP=1 G ITYPEX
139 S IBCNESPC("ITYPE")=Y
140 ;
141ITYPEX ; TYPE exit pt
142 Q
143ISORT ; Prompt to allow users to select primary sort
144 ; Init vars
145 N DIR,X,Y,DIRUT
146 ;
147 S DIR(0)="S^1:Insurance Company Name;2:Payer Name;3:VA National Payer ID;4:Nationally Enabled Status;5:Locally Enabled Status"
148 S DIR("A")="Select the primary sort field"
149 S DIR("B")=1
150 S DIR("?")=" Select the data field by which this report should be primarily sorted."
151 D ^DIR K DIR
152 I $D(DIRUT) S STOP=1 G ISORTX
153 S IBCNESPC("ISORT")=Y
154 ;
155ISORTX ; SORT exit pt
156 Q
157IMAT ; Prompt to allow users to select partial Ins carrier to include
158 N DIR,X,Y,DIRUT
159 ;
160 W !
161 S DIR(0)="FO"
162 S DIR("A")="Enter an insurance company search keyword (RETURN for ALL)"
163 S DIR("B")=""
164 S DIR("?",1)=" Enter a value to match insurance company names with."
165 S DIR("?",2)=" Simply hit RETURN to select ALL or enter a keyword"
166 S DIR("?",3)=" (ex. 'CIGNA' would return CIGNA, CIGNA HICN, NATIONAL CIGNA,"
167 S DIR("?")=" REGION 1 CIGNA and any others with the term 'CIGNA' in it)"
168 D ^DIR K DIR
169 I $D(DUOUT)!$D(DTOUT) S Y="" S STOP=1 G IMATX
170 S IBCNESPC("IMAT")=Y
171 ;
172IMATX Q
Note: See TracBrowser for help on using the repository browser.