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

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

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1IBTUBO3 ;ALB/RB - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;03 Aug 2004 9:12 AM
2 ;;2.0;INTEGRATED BILLING;**123,159,192,155,277**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5REPORT ; - Prepare report if requested, send summary bulletin.
6 N IBRUN,IBN,IBPAG,IBQ,DFN,DTE,FL,PT,X0,X1
7 S IBRUN=$$HTE^XLFDT($H,1)
8 D BULL^IBTUBUL G:'IBDET REPRTQ
9 ;
10REPRT1 S (IBPAG,IBQ,IBX)=0
11 I '$D(^TMP($J)) S X0="" D HDR,NIM D:'IBQ PAUSE G REPRTQ
12 F X0=1,2,3 I IBSEL[X0 D Q:IBQ
13 . S X1="IBTUB-"_$S(X0=2:"OPT",X0=3:"RX",1:"INPT")
14 . D HDR Q:IBQ I '$D(^TMP($J,X1)) D NIM Q
15 . S PT="" F S PT=$O(^TMP($J,X1,PT)) Q:PT="" D Q:IBQ
16 . . S DFN=+$P(PT,"@@",2) Q:'DFN
17 . . S (DTE,FL)="" F S DTE=$O(^TMP($J,X1,PT,DTE)) Q:DTE="" D Q:IBQ
18 . . . S IBX="" F S IBX=$O(^TMP($J,X1,PT,DTE,IBX)) Q:IBX="" D Q:IBQ
19 . . . . S IBN=^TMP($J,X1,PT,DTE,IBX) D LINE Q:IBQ I X1["OPT" D CPTS Q:IBQ
20 ;
21 D:'IBQ PAUSE
22 ;
23REPRTQ Q
24 ;
25HDR ; - Output header.
26 N I,X,XTP
27 I $E(IOST,1,2)="C-",IBPAG D PAUSE G HDRQ:IBQ
28 W:'$G(IBPAG) ! I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
29 S IBPAG=$G(IBPAG)+1 W !,"Unbilled Amounts Report"
30 W ?60,"Run Date: ",IBRUN,?124,"Page ",$J(IBPAG,3)
31 S XTP=$S(X0=1:"INPATIENT",X0=2:"OUTPATIENT",X0=3:"PRESCRIPTIONS",1:"")
32 S:X0'=3 XTP=XTP_" EPISODES" S X="ALL "_XTP_" FROM "
33 S X=X_$$DTE(IBBDT)_" TO "_$$DTE(IBEDT\1)
34 I $G(IBCOMP) D
35 .S X=X_" / DATA RECOMPILED/STORED FOR "_$$DAT2^IBOUTL(IBTIMON)
36 S X=X_" / '*' AFTER THE PATIENT NAME = USUALLY BILLED MEANS TEST COPAYMENT"
37 I X0=1 S X=X_" / 'H' AFTER THE ADMISSION DATE = PATIENT CURRENTLY HOSPITALIZED"
38 I X0=3 S X=X_" / '$' AFTER THE ORIGINAL FILL DATE = ORIGINAL FILL DATE HAS BEEN BILLED"
39 S X=X_" / 'CF' COLUMN = NUMBER OF CLAIMS ON FILE FOR THE EPISODE"
40 I X0'=3 D
41 .S X=X_" / 'I/P' COLUMN = 'I' - INSTUTIONAL CLAIM MISSING,"
42 .S X=X_" 'P' - PROFESSIONAL CLAIM MISSING"
43 F I=1:1 W !,$E(X,1,132) S X=$E(X,133,999) Q:X=""
44 ;
45 I 'X0 W !,$TR($J(" ",IOM)," ","-"),! G HDRQ
46 W !!?29,"Last Prim. Claims" W:X0=3 ?52,"Fill",?123,"Original"
47 W !,"Name",?29,"4SSN Elig. Track.ID#"
48 I X0=1 W ?52,"Admission CF Insurance Carrier(s)",?98,"I/P",?102,"MRA"
49 I X0=2 W ?52,"Care Dt. CF Insurance Carrier(s)",?98,"I/P",?102,"MRA",?106,"CPT I. Rate P. Rate"
50 I X0=3 W ?52,"Date CF Ins. Carrier(s) MRA Drug Name Physician",?123,"Fill Dt."
51 W !,$TR($J(" ",IOM)," ","-"),!
52 I $D(ZTQUEUED),$$S^%ZTLOAD D
53 . W !!,"...Task stoped at user request" S (IBQ,ZTSTOP)=1
54 ;
55HDRQ Q
56 ;
57CPTS ; - Outpatient Only (CPTs and Rates)
58 N CPT,IBN1
59 I $O(^TMP($J,X1,PT,DTE,IBX,""))="" W ?98,"I",?103,$S('$G(IBINMRA):"",$G(^TMP($J,X1_"_MRA",PT,DTE,IBX)):"M",1:"") W ! Q
60 S CPT="" F S CPT=$O(^TMP($J,X1,PT,DTE,IBX,CPT)) Q:CPT="" D Q:IBQ
61 . S IBN1=^TMP($J,X1,PT,DTE,IBX,CPT)
62 . I $Y>(IOSL-5) D HDR Q:IBQ S FL=0 D LINE
63 . W ?98,$P(IBN1,U,3),?103,$S('$G(IBINMRA):"",$G(^TMP($J,X1_"_MRA",PT,DTE,IBX)):"M",1:""),?106,CPT,?113,$J(+IBN1,8,2)
64 . W ?124,$J($P(IBN1,U,2),8,2),!
65 Q
66 ;
67LINE ; - Print detail line.
68 I $Y>(IOSL-6) D HDR G:IBQ LINQ S FL=0
69 I 'FL D
70 . W $E($P(PT,"@@"),1,26) I $$BIL^DGMTUB(DFN,+DTE) W " *"
71 . W ?29,$$SSN(DFN),?34,$E($$ELIG(DFN),1,5) S FL=1
72 ;
73 W ?39,$J(IBX,11)
74 ; - Inpatient and Outpatient Only
75 I X1'["RX" D
76 . W ?52,$$DTE(+DTE) W:X1["INPT" $S($P(IBN,U,5):"H",1:"")
77 . W ?62,$J($P(IBN,U),2),?65,$$INS(DFN,+DTE,34)
78 . I X1["INPT" D
79 .. I $P(IBN,U,2)'="" W ?98,$E($P(IBN,U,2),1,3),!
80 .. I '$G(^TMP($J,X1_"_MRA",PT,DTE,IBX))!'$G(IBINMRA) W:$P(IBN,U,2)="" ! Q
81 .. W ?98,$E($P(^TMP($J,X1_"_MRA",PT,DTE,IBX),U,2),1,3),?103,"M",!
82 ;
83 ; - Pharmacy Only
84 I X1["RX" D G LINQ
85 . W ?52,$$DTE(+DTE),?61,$J($P(IBN,U),2),?64,$$INS(DFN,+DTE,19),?85,$S('$G(IBINMRA):"",$G(^TMP($J,X1_"_MRA",PT,DTE,IBX)):"M",1:"")
86 . W ?88,$E($P(IBN,U,6),1,15),?105,$E($P(IBN,U,2),1,14)
87 . W ?123,$$DTE($P(IBN,U,3)) W:$P(IBN,"^",5) "$" W !
88 ;
89LINQ Q
90 ;
91SSN(DFN) ; - Return last 4 of patient's SSN.
92 N SSN,VADM
93 D DEM^VADPT S SSN=$P(VADM(2),"^"),SSN=$E(SSN,6,9) D KVA^VADPT
94 Q SSN
95 ;
96ELIG(DFN) ; - Return patient's primary eligibility (1st 10 characters).
97 N ELIG,VAEL
98 D ELIG^VADPT S ELIG=$E($P(VAEL(1),"^",2),1,10) D KVAR^VADPT
99 Q ELIG
100 ;
101DTE(D) ; - Format date (MM/DD/YY or MM/YY).
102 Q $S('$G(D):"",1:$E(D,4,5)_"/"_$S($E(D,6,7)'="00":$E(D,6,7)_"/",1:"")_$E(D,2,3))
103 ;
104INS(P,D,C) ; - Return patient's insurance carrier(s).
105 ; Input: P=patient IEN, D=event date, C=Size of the Ins.Carrier column
106 ; Output: List of Providers
107 ;
108 I '$G(P)!('$G(D)) Q ""
109 ;
110 N INSC,INSL,INSN,LST,TMP,X
111 ;
112 S INSL="" D ALL^IBCNS1(P,"LST",1,D)
113 S X=0 F S X=$O(LST(X)) Q:'X D
114 . S INSC=+$G(LST(X,0)) Q:$D(TMP(INSC))!'INSC
115 . S INSN=$P($G(^DIC(36,INSC,0)),U)
116 . I $G(LST(0))>1 S INSN=$E(INSN,1,C\2)
117 . S INSL=INSL_","_INSN
118 . S TMP(INSC)=""
119 ;
120 S $E(INSL)=""
121 I $L(INSL,",")>1,$L(INSL)>C D
122 . S INSL=$E(INSL,1,C-3),$P(INSL,",",$L(INSL,","))="..."
123 S INSL=$E(INSL,1,C)
124 ;
125 Q INSL
126 ;
127NIM ; - Print 'no info' message.
128 W !?3,"No information available for the period specified."
129 Q
130 ;
131PAUSE ; - Page break.
132 I $E(IOST,1,2)'="C-" Q
133 N IBI,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
134 F IBI=$Y:1:(IOSL-3) W !
135 S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
136 Q
Note: See TracBrowser for help on using the repository browser.