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

source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCONS1.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: 9.4 KB
RevLine 
1IBCONS1 ;ALB/AAS - NSC PATIENTS W/ INS BACKGROUND PRINTS ;7 JUN 90
2 ;;2.0;INTEGRATED BILLING;**66,80,137**;21-MAR-94
3 ;
4 ;MAP TO DGCRONS1
5 ;
6EN ; Inpatient Discharge entry to que background once weekly
7 S IBINPT=2,IBSUB="AMV3" G QUEUE
8 ;
9EN1 ; Inpatient Admission entry to que background once weekly
10 S IBINPT=1,IBSUB="AMV1" G QUEUE
11 ;
12EN2 ; Outpatient entry to que background once weekly
13 S IBINPT=0,IBSUB=""
14 ;
15QUEUE ; Set up the background job to run for the previous week
16 ; o For All Divisions
17 ; o For Insured veterans with unbilled episodes of care
18 ; o With the output sorted by Terminal Digit
19 ;
20 K ^TMP($J)
21 S X="T",%DT="" D ^%DT S IBEND=+Y
22 S X="T-7",%DT="" D ^%DT S IBBEG=+Y K %DT
23 S (VAUTD,IBSELUBL,IBSELTRM,IBSELRNB)=1
24 U IO G BEGIN^IBCONSC
25 ;
26 ;
27LOOP25 ; Print all NSC w/Insurance reports.
28 S IBQUIT=0,IBFL=1,IBHDRDV="",IBSUM=0 I +$G(IBSELCDV) D HDRDV^IBCONSC
29 S IBDV="" F S IBDV=$O(^TMP($J,IBDV)) Q:IBDV="" I IBDV'="TOTAL" D LOOP3 Q:IBQUIT
30 ;
31 G:IBQUIT Q S IBSUM=1,IBPAGE=0 D HEAD Q:IBQUIT
32 S IBDV="" F S IBDV=$O(^TMP($J,"TOTAL",IBDV)) Q:IBDV="" D PRNSUM
33 D PAUSE
34 ;
35Q K %,%DT,B,I,J,K,L,M,X,X1,X2,Y,DFN,IBCNT,IBIFN,IBBILL,IBDATE,IBFLAG,IBI,IBDT,IBPAGE,IBL,IBHD,IBBEG1,IBHDRDV,IBSUM
36 K IBBEG,IBEND,IBINPT,IBFLAG,IBNAME,IBAPPT,IBDC,IBDAT,IBDFN,POP,IBNEWPT,^TMP($J)
37 ;I '$D(ZTQUEUED) D ^%ZISC
38 Q
39 ;
40 ;
41LOOP3 ; Loop through billed, unbilled, or both types of episodes of care.
42 I +$G(IBSELUBL) S IBBILL=1,IBNAME="",IBPAGE=0 K IBFLAG D HEAD Q:IBQUIT D LOOP31 Q:IBQUIT
43 I +$G(IBSELBNA)!+$G(IBSELBIL) S IBBILL=2,IBNAME="",IBPAGE=0 K IBFLAG D HEAD Q:IBQUIT D LOOP31 Q:IBQUIT
44 Q
45 ;
46LOOP31 ; Loop through each name or terminal digit (and associated DFN).
47 F S IBNAME=$O(^TMP($J,IBDV,IBBILL,IBNAME)) D Q:IBNAME=""!(IBQUIT)
48 . I IBNAME="",'$D(IBFLAG) W !!,"No matches found.",!
49 . Q:IBNAME=""
50 . S DFN=0 F S DFN=$O(^TMP($J,IBDV,IBBILL,IBNAME,DFN)) Q:'DFN S IBNEWPT=1 D LOOP4 Q:IBQUIT
51 Q
52 ;
53LOOP4 ; Loop through each episode of care for a patient.
54 S IBDAT="" F I=0:0 S IBDAT=$O(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT)) Q:IBDAT=""!(IBQUIT) D PRINT I $Y>$S($D(IOSL):(IOSL-6),1:6) W ! D HEAD Q:IBQUIT
55 Q
56 ;
57PRINT ; Print each detail line.
58 I '$G(IBSELRNB),$D(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT,2)) Q ; exclude episodes with reason not billable
59 I +$G(IBSELRNB)=2,'$D(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT,2)) Q ; exclude episode w/o RNB ** PATCH 66
60 I IBBILL=2,'$G(IBSELBNA),+$G(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT))=1 Q ; non-auth episodes ** PATCH 66
61 I IBBILL=2,'$G(IBSELBIL),+$G(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT))=2 Q ; auth episodes ** PATCH 66
62 ;
63 I +$G(IBNEWPT) W ! D PTPRNT S IBNEWPT=0
64 D SUMTOT S IBFLAG=1 D PID^VADPT6
65 W !,VA("BID"),?6,$E($P(^DPT(DFN,0),"^"),1,20),?28,VA("PID"),?42,$E($P($G(^DIC(8,+$G(^(.36)),0)),"^",6),1,16) K VA,VAERR
66 S Y=IBDAT X ^DD("DD") W ?60,Y
67 ;
68 ; -- print insurance, use ibcns1 calls
69 S X=$$INSP(DFN,IBDAT) W ?82,X
70 ;
71 ;S IBCNT=0 F II=0:0 S II=$O(^DPT(DFN,.312,II)) Q:'II S IBCNT=IBCNT+1,X=+^(II,0) D
72 ;. I $D(^DIC(36,X,0)) W:IBCNT=2!(IBCNT=3) ", " W:IBCNT<4 $E($P(^(0),"^"),1,14) W:IBCNT=4 " " W:IBCNT>3 "*"
73 ;
74 ; -- print reason not billable
75 I $G(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT,2))]"" W ?115,$E(^(2),1,16)
76 ;
77 S X=$G(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT,1))
78 I X]"" W !?10,$P(X,"^") I $P(X,"^",2)]"" W " with " F IBDC=2:1 Q:$P(X,"^",IBDC)="" W $P(X,"^",IBDC),", "
79 S X=^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT) Q:'$L(X) F K=2:1 S IBIFN=$P(X,"^",K) Q:IBIFN="" D PRINT1
80 Q
81 ;
82PRINT1 ; If an episode of care has been billed, display billing information.
83 D GVAR^IBCBB
84 W !?10,$P(^DGCR(399,IBIFN,0),"^"),?20,$P($G(^DGCR(399.3,+IBAT,0)),"^",4),"-",$S(IBCL<3:"INPT",IBCL>2:"OUTP",1:"")
85 W ?37,$S(IBST=1:"Entered",IBST=2:"Request MRA",IBST=3:"Authorized",IBST=4:"Prnt/Trans",IBST=7:"Cancelled",IBST=0:"Closed",1:"")
86 W ?50,"From: ",$E(IBFDT,4,5)_"/"_$E(IBFDT,6,7)_"/"_$E(IBFDT,2,3)
87 W ?68,"To: ",$E(IBTDT,4,5)_"/"_$E(IBTDT,6,7)_"/"_$E(IBTDT,2,3)
88 W ?88,$S($P(IBND0,U,21)="S":"s",$P(IBND0,U,21)="T":"t",1:"")
89 W ?91,"Debtor: "
90 I IBWHO="i",$D(^DIC(36,+IBNDMP,0)) W $P(^(0),"^")
91 I IBWHO="o",$D(^DIC(4,+$P(IBNDM,"^",11),0)) W $P(^(0),"^")
92 I IBWHO="p" W $P(^DPT(DFN,0),"^")
93 D END^IBCBB1 Q
94 ;
95HEAD ; Print header; don't pause on first pass through.
96 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,IBQUIT)=1 Q
97 D:'IBFL PAUSE Q:IBQUIT S IBFL=0 N IBI
98 S IBPAGE=IBPAGE+1
99 ; -- ibformfd = skip only intial form feed, need ffs for each div.
100 I $E(IOST,1,2)["C-"!(IBPAGE>1)!($G(IBFORMFD)) W @IOF
101 S IBFORMFD=1
102 S IBI=$S(IBBILL=2:"PREVIOUSLY ",1:"UN")_"BILLED PATIENTS"
103 I '$G(IBSELCDV) S IBI=IBI_" for Division "_$P($G(^DG(40.8,+IBDV,0)),"^")
104 I +$G(IBSELCDV) S IBI=IBI_IBHDRDV
105 I +$G(IBSUM) S IBI="Summary"
106 W IBHD,!,IBI W:$L(IBI)>78 ! W ?80,"Printed: ",IBDATE,?118,"Page: ",IBPAGE
107 I +$G(IBSUM) W !,?40,"Unbilled",?53,"Unbilled w/RNB",?70,"Billed/Not Auth",?88,"Billed/Auth",?103,"# Visits",?117,"# Patients",!,IBL Q
108 W !,"PT ID PATIENT",?28,"SSN",?42,"ELIGIBILITY",?60,"DATE OF ",$S(IBINPT=2:"DISCHARGE",1:"CARE"),?82,"INSURANCE COMPANIES"
109 W:+$G(IBSELRNB) ?115,"NOT BILLABLE"
110 W !,IBL
111 Q
112 ;
113INSP(DFN,IBDAT) ; -- print ins. company on report logic
114 N X,IBDD,IBDDINS,IBCNT
115 S IBCNT=0,IBDDINS=""
116 I '$G(DFN)!('$G(IBDAT)) G INSPQ
117 S IBDD="" D ALL^IBCNS1(DFN,"IBDD",4,IBDAT)
118 S X=0 F S X=$O(IBDD(X)) Q:'X!(IBCNT>2) D
119 .S IBCNT=IBCNT+1
120 .I IBCNT>1 S IBDDINS=IBDDINS_","
121 .S IBDDINS=IBDDINS_$E($P($G(^DIC(36,+$G(IBDD(X,0)),0)),"^"),1,10)
122 S IBDDINS=$E(IBDDINS,1,30)
123 I $G(IBDD(0))>3 S IBDDINS=IBDDINS_"*"
124INSPQ Q IBDDINS
125 ;
126PAUSE Q:$E(IOST,1,2)'="C-"
127 F J=$Y:1:(IOSL-5) W !
128 S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
129 Q
130PRNSUM ; print 1 line of the summary
131 N IBSUM S IBSUM=$G(^TMP($J,"TOTAL",IBDV)) Q:IBSUM=""
132 W !,$S(IBDV="TOTAL":IBDV,1:$P($G(^DG(40.8,+IBDV,0)),U,1))
133 W ?40,$P(IBSUM,U,2),?58,$P(IBSUM,U,3),?75,$P(IBSUM,U,4),?91,$P(IBSUM,U,5),?105,$P(IBSUM,U,1),?120,$P(IBSUM,U,6)
134 Q
135DATE(X) ;
136 N Y S Y="" I +$G(X) S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
137 Q Y
138 ;
139SUMTOT ; total cnt of visits ^ cnt unbilled ^ cnt unbilled w/RNB ^ cnt billed/not auth ^ cnt billed/auth ^ cnt of pats
140 N IBSUM,IBTOT,IBBILLED,IBRMARK
141 S IBBILLED=$G(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT)),IBRMARK=$G(^TMP($J,IBDV,IBBILL,IBNAME,DFN,IBDAT,2))
142 S IBSUM=$G(^TMP($J,"TOTAL",+IBDV)),IBTOT=$G(^TMP($J,"TOTAL","TOTAL"))
143 S $P(IBSUM,U,1)=+$P(IBSUM,U,1)+1,$P(IBTOT,U,1)=+$P(IBTOT,U,1)+1
144 I 'IBBILLED,IBRMARK="" S $P(IBSUM,U,2)=$P(IBSUM,U,2)+1,$P(IBTOT,U,2)=$P(IBTOT,U,2)+1
145 I 'IBBILLED,IBRMARK'="" S $P(IBSUM,U,3)=$P(IBSUM,U,3)+1,$P(IBTOT,U,3)=$P(IBTOT,U,3)+1
146 I +IBBILLED=1 S $P(IBSUM,U,4)=$P(IBSUM,U,4)+1,$P(IBTOT,U,4)=$P(IBTOT,U,4)+1
147 I +IBBILLED=2 S $P(IBSUM,U,5)=$P(IBSUM,U,5)+1,$P(IBTOT,U,5)=$P(IBTOT,U,5)+1
148 I '$D(^TMP($J,"TOTAL",+IBDV,DFN)) S $P(IBSUM,U,6)=$P(IBSUM,U,6)+1
149 I '$D(^TMP($J,"TOTAL","TOTAL",DFN)) S $P(IBTOT,U,6)=$P(IBTOT,U,6)+1
150 I +IBDV S ^TMP($J,"TOTAL",+IBDV)=IBSUM,^TMP($J,"TOTAL",+IBDV,DFN)=""
151 S ^TMP($J,"TOTAL","TOTAL")=IBTOT,^TMP($J,"TOTAL","TOTAL",DFN)=""
152 Q
153 ;
154PTPRNT ; print patient specific data is requested: Rate Disabilities and expanded insurance Info
155 ;
156 N IBLN1,IBI,IBX,IBY,IBD,IBLN2,IBLN3,IBY1,IBJ,IBY3,IBRIDE,IBPLAN,IBCVG
157 S IBLN1=$P($G(^DPT(+DFN,0)),U,1) I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
158 ;
159 I +$G(IBPRTRDS) S IBLN2="Rated Disabilities:" D Q:+$G(IBQUIT) K IBX,IBY
160 . I '$O(^DPT(DFN,.372,0)) W !,IBLN1,?33,IBLN2," None" S (IBLN1,IBLN2)="" Q
161 . S IBI=0 F S IBI=$O(^DPT(DFN,.372,IBI)) Q:'IBI D I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
162 .. S IBX=$G(^DPT(DFN,.372,IBI,0)),IBY=$G(^DIC(31,+IBX,0))
163 .. S IBD=$S($P(IBY,U,4)="":$P(IBY,U,1),1:$P(IBY,U,4))_" ("_$P(IBX,U,2)_"%-"_$S(+$P(IBX,U,3):"SC",1:"NSC")_")"
164 .. W !,IBLN1,?33,IBLN2,?57,IBD S (IBLN1,IBLN2)=""
165 ;
166 I '$G(IBPRTIEX),'$G(IBPRTIPC),'$G(IBPRTIGC),'$G(IBPRTICR) Q
167 ;
168 W:IBLN1'="" !,IBLN1
169 D ALL^IBCNS1(DFN,"IBX",4,IBBEG),ALL^IBCNS1(DFN,"IBX",4,IBEND)
170 ;
171 S IBI=0 F S IBI=$O(IBX(IBI)) Q:'IBI D Q:+$G(IBQUIT) I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
172 . S IBY=IBX(IBI,0),IBY1=IBX(IBI,1)
173 . S IBLN1=$E($P($G(^DIC(36,+IBY,0)),U,1),1,25),IBPLAN=+$P(IBY,U,18)
174 . ;
175 . I +$G(IBPRTIEX) W !,?5,IBLN1,?33,"Group #: ",$P($G(^IBA(355.3,+IBPLAN,0)),U,4),?65,"Effective: ",$$DATE(+$P(IBY,U,8))," - ",$$DATE(+$P(IBY,U,4)),?100,"Last Ver: ",$$DATE($P(IBY1,U,3)) S IBLN1=""
176 . ;
177 . I +$G(IBPRTIPC) S IBLN2="Policy Comment: " D I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
178 .. I $P(IBY1,U,8)'="" W !,?5,IBLN1,?33,IBLN2,?51,$P(IBY1,U,8) S (IBLN1,IBLN2)=""
179 . ;
180 . I +$G(IBPRTIGC) S IBLN2="Group Comments: " D
181 .. S IBJ=0 F S IBJ=$O(^IBA(355.3,+IBPLAN,11,IBJ)) Q:'IBJ D I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
182 ... S IBY3=$G(^IBA(355.3,+IBPLAN,11,IBJ,0)) W !,?5,IBLN1,?33,IBLN2,?51,IBY3 S (IBLN1,IBLN2)=""
183 . ;
184 . I +$G(IBPRTICR) S IBLN2="Coverage Limits:" D
185 .. S IBCVG=0 F S IBCVG=$O(^IBA(355.32,"B",IBPLAN,IBCVG)) Q:'IBCVG D I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
186 ... S IBY3=$G(^IBA(355.32,IBCVG,0)) Q:IBY3=""
187 ... S IBLN3=$E($P($G(^IBE(355.31,+$P(IBY3,U,2),0)),U,1),1,20)_" "_$$DDSET(355.32,.04,+$P(IBY3,U,4))_" "_$$DATE(+$P(IBY3,U,3))
188 ... S IBJ=0 F S IBJ=$O(^IBA(355.32,IBCVG,2,IBJ)) Q:'IBJ D I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
189 .... W !,?5,IBLN1,?33,IBLN2,?51,IBLN3,?104,$G(^IBA(355.32,IBCVG,2,IBJ,0)) S (IBLN1,IBLN2,IBLN3)=""
190 ... I IBLN3'="" W !,?5,IBLN1,?33,IBLN2,?51,IBLN3 S (IBLN1,IBLN2,IBLN3)=""
191 . ;
192 . I +$G(IBPRTICR) S IBLN2="Riders: " D
193 .. S IBRIDE=0 F S IBRIDE=$O(^IBA(355.7,"APP",DFN,IBI,IBRIDE)) Q:'IBRIDE D I $Y>(IOSL-6) W ! D HEAD Q:IBQUIT
194 ... W !,?5,IBLN1,?33,IBLN2,?51,$P($G(^IBE(355.6,+IBRIDE,0)),U,1) S (IBLN1,IBLN2)=""
195 ;
196 W !
197 Q
198 ;
199DDSET(FILE,FLD,X) ; returns external value for a set
200 N Y,Z,T S Z="",Y=$G(^DD(+$G(FILE),+$G(FLD),0)) S T=$G(X)_":",Z=$P($P(Y,T,2),";",1)
201 Q Z
Note: See TracBrowser for help on using the repository browser.