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

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

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1IBCEQ1A ;ALB/BSL,TMK - PROVIDER ID QUERY REPORT ;25-AUG-03
2 ;;2.0;INTEGRATED BILLING;**232,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5RPTOUT ; Print from data in ^XTMP
6 N IBP,IBA,IBI,IBIN,IBPNM,IBPNUM,IBSTOP,IBX,IBZ,IBPG,IBICONT,Z
7 K ^TMP($J,"IBZ232")
8 F Z=1:1:6 S ^TMP($J,"IBZ232",Z)=""
9 S (IBPG,IBSTOP)=0
10 S IBA=0 F S IBA=$O(^XTMP("IB_PLAN232",1,IBA)) Q:'IBA D
11 . S IBX=$G(^XTMP("IB_PLAN232",1,IBA,0))
12 . ; Sort by err type, ins co ien
13 . S ^TMP($J,"IBZ232",+$P(IBX,U,16),+$P(IBX,U,11),IBA)=IBX
14 ;
15 S IBZ=0 F S IBZ=$O(^TMP($J,"IBZ232",IBZ)) Q:'IBZ!IBSTOP!(IBZ>6) D HDR1(.IBPG,.IBSTOP,IBZ,0) S IBI=0 F S IBI=$O(^TMP($J,"IBZ232",IBZ,IBI)) Q:'IBI!IBSTOP D
16 . S IBIN=$P($G(^DIC(36,+IBI,0)),U)_" ("_$S(+$G(^(3))=1:"",1:"NOT ")_"SET TO TRANSMIT LIVE)"
17 . D INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,0) S IBICONT=0
18 . S IBA=0 F S IBA=$O(^TMP($J,"IBZ232",IBZ,IBI,IBA)) Q:'IBA!IBSTOP S IBX=$G(^(IBA)) D
19 .. I ($Y+5)>IOSL D INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,IBICONT) Q:IBSTOP
20 .. ;
21 .. I IBZ'=4,IBZ'=5 D
22 ... S IBP=+$P(IBX,U,14)
23 ... I $P(IBX,U,14)[".91" S IBPNM="ALL PROVIDERS"
24 ... I $P(IBX,U,14)'[".91" D
25 .... N Z
26 .... S Z=$P($G(^IBA(355.9,IBP,0)),U)
27 .... S IBPNM=$S(Z["VA(200":"",1:"#")_$$EXTERNAL^DILFD(355.9,.01,"",Z)
28 ... S IBPNUM=$P($G(^IBA(+$P($P(IBX,U,14),";",2),IBP,0)),U,7)
29 ... D WRT(1," "_$E($P("BOTH^UB-04^CMS-1500",U,$P(IBX,U,4)+1)_$J("",9),1,9)_" "_$E($P(IBX,U,15)_$J("",23),1,23)_" "_$E(IBPNM_$J("",28),1,28)_" "_$E(IBPNUM,1,11))
30 .. ;
31 .. I IBZ=4!(IBZ=5) D
32 ... N Z
33 ... S Z=$G(^IBA(355.3,+$P(IBX,U,13),0))
34 ... D WRT(1," "_$E($P(Z,U,3)_$J("",20),1,20)_" "_$E($P(Z,U,4)_$J("",17),1,17)_" "_$$EXTERNAL^DILFD(355.3,.15,"",$P(Z,U,15)))
35 .. S:'IBICONT IBICONT=1
36 ;
37 I 'IBSTOP D ;Totals
38 . N Z
39 . S Z=$G(^XTMP("IB_PLAN232"))
40 . I ($Y+10)>IOSL!'IBPG D HDR(.IBPG,.IBSTOP,"") Q:IBSTOP
41 . D WRT(2,$J("",25)_"TOTAL # OF IDs CHECKED: "_+$P(Z,U,4))
42 . D WRT(1,$J("",14)_"TOT # BLUE CROSS/SHIELD IDS FOUND: "_+$P(Z,U,5))
43 . D WRT(1,"TOTAL # OF INS CO. W/BLUE PLANS AND NO BLUE IDS: "_+$P(Z,U,3))
44 . D WRT(1,$J("",21)_"TOTAL # OF ERRORS/WARNINGS: "_+$P(Z,U,6))
45 ;
46 I '$D(ZTQUEUED) D ^%ZISC I 'IBSTOP,IBPG D ASK()
47 I $D(ZTQUEUED),'IBSTOP S ZTREQ="@"
48 I $G(^TMP($J,"SENDMSG")),'IBSTOP D
49 . N XMDUZ,XMSUBJ,XMBODY,XMTO,XMZ
50 . S XMDUZ=DUZ,XMSUBJ=$E("PROVIDER ID QUERY FROM "_$P($G(^DIC(4,+$P($G(^IBE(350.9,1,0)),U,2),0)),U),1,65),XMBODY="^TMP($J,""SENDMSG"",1)"
51 . M XMTO=^TMP($J,"SENDMSG",0)
52 . S Z="" F S Z=$O(^TMP($J,"SENDMSG",0,Z)) Q:Z="" S XMZ(Z)=""
53 . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,"",.XMZ)
54 K ^TMP($J,"IBZ232"),^TMP($J,"SENDMSG")
55 Q
56 ;
57HDR(IBPG,IBSTOP,IBZ,FF) ; Main hdr
58 ; FF = 0 if continuation pg so it writes it to report, but not mail msg
59 N Z,IBT
60 Q:$G(IBSTOP)
61 I $D(ZTQUEUED),$$S^%ZTLOAD S (IBSTOP,ZTSTOP)=1 K ZTREQ I +$G(IBPG) D WRT(2,"***TASK STOPPED BY USER***") Q
62 I IBPG&($E(IOST,1,2)="C-") D ASK(.IBSTOP) Q:IBSTOP
63 S IBT=$S(IBPG:1,1:0)
64 S IBPG=IBPG+1
65 S Z="PROVIDER ID VERIFICATION QUERY REPORT"
66 S Z=$$SETSTR^VALM1($J("",80-$L(Z)\2)_Z,"",1,79)
67 S Z=$$SETSTR^VALM1("Page: "_IBPG,Z,70,10)
68 D WRT(0,"@IOF",$G(FF))
69 D WRT(1,Z,$G(FF))
70 S Z="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z=$J("",80-$L(Z)\2)_Z
71 D WRT(1,Z,$G(FF))
72 I IBZ'="",IBZ'=4,IBZ'=5 D
73 . D WRT(2," FORM TYPE PROV ID TYPE"_$J("",12)_"PROVIDER NAME (#=Non-VA)"_$J("",6)_"PROV ID",$G(FF))
74 I IBZ=4!(IBZ=5) D
75 . D WRT(2," GROUP NAME"_$J("",12)_"GROUP NUMBER"_$J("",7)_"ELECTRONIC PLAN TYPE",$G(FF))
76 D WRT(1,$TR($J("",IOM-1)," ","-"),$G(FF))
77 Q
78 ;
79HDR1(IBPG,IBSTOP,IBZ,IBCONT) ; Hdr err typ
80 N Z,Z0,Z1
81 D HDR(.IBPG,.IBSTOP,IBZ,IBCONT) Q:IBSTOP
82 S Z="",$P(Z,"*",80)="" D WRT(1,Z,IBCONT)
83 S Z0="* "_$S(IBZ>1:"WARNING: ",1:"ERROR: ")
84 ;
85 I IBZ'=4,IBZ'=5 D
86 . N X
87 . S X="BLUE CROSS ID FOUND FOR A 1500 FORM TYPE ONLY^BLUE SHIELD ID FOUND FOR A UB-04 FORM TYPE ONLY^BLUE CROSS ID FOUND FOR BOTH FORM TYPES^BL CROSS/BL SHIELD IDs FOUND FOR PLANS NOT HAVING 'BL' ELECTRONIC PLAN TYPE"
88 . S Z0=Z0_$S(IBZ<6:$P(X,U,IBZ),IBZ=6:"""VAD000"" PROVIDER ID FOUND NOT SET UP AS A UPIN PROVIDER ID TYPE",1:"")
89 I IBZ=4 D
90 . S Z0=Z0_"BL CROSS/BL SHIELD IDs FOUND FOR PLANS NOT HAVING 'BL' ELECTRONIC" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
91 . S Z0="*"_$J("",10)_"PLAN TYPE"
92 ;
93 I IBZ=5 D
94 . S Z0=Z0_"INSURANCE CO HAS BL CROSS/SHIELD PLANS, BUT NO BL CROSS/SHIELD IDs"
95 ;
96 S Z0=Z0_$S(IBCONT:" (CONT)",1:"")
97 D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
98 ;
99 I 'IBCONT D
100 . I IBZ=1 D
101 .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
102 .. S Z0="* SOLUTION: THIS ID WILL NEVER BE USED ELECTRONICALLY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
103 .. S Z0="*"_$J("",11)_"CHANGE PROVIDER ID TYPE TO BLUE SHIELD IF THIS ID SHOULD BE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
104 .. S Z0="*"_$J("",11)_"TRANSMITTED ON A 1500." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
105 . ;
106 . I IBZ=2 D
107 .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
108 .. S Z0="* SUGGESTION: VISTA WILL TRANSMIT THIS ID ELECTRONICALLY, BUT IT IS OPTIMAL" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
109 .. S Z0="*"_$J("",13)_"TO HAVE THIS ID SET UP AS BLUE CROSS." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
110 . ;
111 . I IBZ=3 D
112 .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
113 .. S Z0="* SUGGESTION: A BLUE CROSS ID CAN ONLY BE APPLIED TO A UB-04 FORM TYPE." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
114 .. S Z0="*"_$J("",13)_"EDIT THE 'APPLIED TO FORM TYPE' FOR THE ID TO BE UB-04 ONLY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
115 .. S Z0="*"_$J("",13)_"IF YOU NEED THIS ID ON A 1500, SET IT UP AS A BLUE SHIELD ID" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
116 .. S Z0="*"_$J("",13)_"APPLIED TO A CMS-1500 FORM TYPE." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
117 . ;
118 . I IBZ=4 D
119 .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
120 .. S Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD ID IS DEFINED FOR THE INSURANCE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
121 .. S Z0="*"_$J("",13)_"COMPANY, BUT THE ELECTRONIC PLAN TYPE FOR ONE OR MORE OF THE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
122 .. S Z0="*"_$J("",13)_"COMPANY'S PLANS IS NOT SET TO 'BL' (BLUE CROSS/BLUE SHIELD)." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
123 .. S Z0="*"_$J("",13)_"IF BLUE CROSS/BLUE SHIELD IDs ARE NEEDED TO PRINT FOR ANY" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
124 .. S Z0="*"_$J("",13)_"OF THESE PLANS, ITS ELECTRONIC PLAN TYPE MUST BE CHANGED TO BL." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
125 . ;
126 . I IBZ=5 D
127 .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
128 .. S Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD PLAN IS DEFINED FOR THE INSURANCE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
129 .. S Z0="*"_$J("",13)_"COMPANY, BUT YOU HAVE ONLY NON-BLUE CROSS/SHIELD IDS SET UP." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
130 .. S Z0="*"_$J("",13)_"YOU MUST SET UP THE APPROPRIATE BLUE CROSS/BLUE SHIELD IDs" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
131 .. S Z0="*"_$J("",13)_"FOR THE INSURANCE COMPANY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
132 . ;
133 . I IBZ=6 D
134 .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
135 .. S Z0="* SUGGESTION: CHANGE PROVIDER ID TYPE TO UPIN."
136 .. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
137 .. S Z0="*"_$J("",13)_"ONCE ALL PAYERS FULLY IMPLEMENT HIPAA EDITS, YOU"
138 .. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
139 .. S Z0="*"_$J("",13)_"MUST USE THE CORRECT ID TYPE FOR THE ID ENTERED."
140 .. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
141 . ;
142 . D WRT(1,"*"_$J("",77)_"*",IBCONT)
143 . S Z1="*"_$J("",$S(IBZ'=1:13,1:11))_"VISTA OPTION TO USE: "
144 . I IBZ'=4 D
145 .. S Z0=Z1_"PROVIDER ID MAINTENANCE"
146 . I IBZ=4 D
147 .. S Z0=Z1_"INSURANCE COMPANY ENTRY/EDIT"
148 . D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
149 ;
150 D WRT(1,Z,IBCONT)
151 ;
152 I '$O(^TMP($J,"IBZ232",IBZ,0)) D WRT(2,"***** NOTHING FOUND FOR THIS ERROR/WARNING *****",IBCONT)
153 Q
154 ;
155INSHDR(IBPG,IBSTOP,IBINM,IBZ,IBICONT) ; Ins Co info
156 I ($Y+7)>IOSL D HDR1(.IBPG,.IBSTOP,IBZ,1)
157 Q:IBSTOP
158 D WRT(2,"INSURANCE CO NAME: "_IBINM_$S($G(IBICONT):" (Continued)",1:""),IBICONT)
159 Q
160 ;
161ASK(IBSTOP) ; Ask continue
162 ; If passed by ref, IBSTOP returned = 1 if print aborted
163 I $E(IOST,1,2)'["C-" Q
164 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
165 S DIR(0)="E" W ! D ^DIR
166 I ($D(DIRUT))!($D(DUOUT)) S IBSTOP=1 Q
167 Q
168 ;
169WRT(FF,TEXT,NOT) ; Wrt/store line
170 N Z,A
171 S A=+$O(^TMP($J,"SENDMSG",1,""),-1),NOT=$G(NOT)
172 I FF F Z=1:1:FF W ! I $G(^TMP($J,"SENDMSG")),'NOT,Z>1 S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
173 ;
174 I TEXT="@IOF" D Q
175 . W @IOF
176 . I $G(^TMP($J,"SENDMSG")),'NOT,IBPG>1 D
177 .. S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
178 .. F Z=1:1:2 S A=A+1,^TMP($J,"SENDMSG",1,A)="*** TOP OF NEW PAGE ***"
179 .. S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
180 ;
181 W TEXT
182 I $G(^TMP($J,"SENDMSG")),'NOT S A=A+1,^TMP($J,"SENDMSG",1,A)=TEXT
183 Q
184 ;
Note: See TracBrowser for help on using the repository browser.