source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDSCRP2.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 7.3 KB
Line 
1SDSCRP2 ;ALB/JAM/RBS - Recovered Costs Report for ASCD ; 3/13/07 2:50pm
2 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
3 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
4 ;;known as Service Connected Automated Monitoring (SCAM).
5 ;
6 ;**Program Description**
7 ; This program will report on all bills generated and amounts
8 ; received for encounters whose Service Connected was changed
9 ; from 'Yes' to 'No'.
10 Q
11EN ; Entry point - find all records
12 ; Get Division
13 N SDSCDVSL,SDSCDVLN,SDRUN,ZTDESC,ZTRTN,ZTIO,ZTSAVE,DIR,X,Y
14 D DIV^SDSCUTL
15 D ^DIR
16 I $G(DTOUT)!($G(DUOUT)) G EXIT
17 S SDSCDVSL=Y,SDSCDVLN=SCLN K DIR,Y,X,SCLN
18 S SDRUN=$$HTE^XLFDT($H,1),ZTDESC="RECOVERED COSTS REPORT",ZTRTN="BEG^SDSCRP2"
19 ; Get start and end date for report.
20 D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
21 W !!,"You will need a 132 column printer for this report!",!
22 K %ZIS S %ZIS="QM" D ^%ZIS G EXIT:POP
23 I '$D(IO("Q")) K ZTDESC G @ZTRTN
24 S ZTIO=ION,ZTSAVE("*")=""
25 D ^%ZTLOAD
26 G EXIT
27 ;
28BEG ; Begin report
29 N P,L,SDABRT,CT,SDSCDIV,SDSCDNM,THDR,SDI,DFTOTB,DFTOTP,DTTOTB,DTTOTP
30 S (P,L,SDABRT,CT)=0
31 S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
32 I SDSCDIV="" S SDSCDNM="ALL" D FND G EXT
33 I SDSCDIV'="" D
34 . S THDR=""
35 . F SDI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",SDI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
36 .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D FND
37 G EXT
38 ;
39FND ; Find records
40 N SDATA,SDOEDT,SDOE,DFN,ENCDT,SDCLM,GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP
41 N BILN,TCHRG,TPAY,AUTHDT,SDWHO,PYMDT,ENCDT,SDSCD,SDPAT,VADM,SCVAL,SDBTR
42 K ^TMP($J,"SDSCBILL")
43 S SDOEDT=SDSCTDT
44 F S SDOEDT=$O(^SDSC(409.48,"C","C",SDOEDT)) Q:SDOEDT=""!(SDOEDT\1>SDEDT) D
45 . S SDOE=0
46 . F S SDOE=$O(^SDSC(409.48,"C","C",SDOEDT,SDOE)) Q:'SDOE D
47 .. S SDATA=$G(^SDSC(409.48,SDOE,0)) I SDATA="" Q
48 .. I $P(SDATA,U,5)'="C" Q
49 .. I SDSCDIV'="" Q:$P(SDATA,U,12)'=SDSCDIV
50 .. I '+$$GETOE^SDOE(SDOE) Q
51 .. ;find only encounters that were changed by ASCD from SC to NSC
52 .. S SCVAL=$$SCHNG^SDSCUTL(SDOE) I '+SCVAL Q
53 .. I $P(SCVAL,U,3) Q
54 .. D FPCK
55 .. D TPCK
56PRT ;
57 U IO D HDR I $G(SDABRT)=1 Q
58 S (GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP)=0
59 I SDSCDIV'="" S DFTOTB(SDSCDNM)=0,DFTOTP(SDSCDNM)=0,DTTOTB(SDSCDNM)=0,DTTOTP(SDSCDNM)=0
60 S SDOE=""
61 F S SDOE=$O(^TMP($J,"SDSCBILL","COPAY",SDOE)) Q:SDOE="" D Q:$G(SDABRT)=1
62 . S BILN=""
63 . F S BILN=$O(^TMP($J,"SDSCBILL","COPAY",SDOE,BILN)) Q:BILN="" D Q:$G(SDABRT)=1
64 .. S SDBTR=^TMP($J,"SDSCBILL","COPAY",SDOE,BILN)
65 .. S TCHRG=$P(SDBTR,U,5)
66 .. S TPAY=$P(SDBTR,U,3)
67 .. S AUTHDT=$P(SDBTR,U,2)\1
68 .. S SDWHO=$$SVCC(SDOE)
69 .. S PYMDT=$P(SDBTR,U,4)
70 .. S SDSCD=$G(^SDSC(409.48,SDOE,0))
71 .. S ENCDT=$P(SDSCD,U,7)\1
72 .. S DFN=$P(SDSCD,U,11)
73 .. D DEM^VADPT S SDPAT=$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
74 .. S GTOTB=GTOTB+TCHRG,GTOTP=GTOTP+TPAY,FTOTB=FTOTB+TCHRG,FTOTP=FTOTP+TPAY
75 .. S DFTOTB(SDSCDNM)=$G(DFTOTB(SDSCDNM))+TCHRG,DFTOTP(SDSCDNM)=$G(DFTOTP(SDSCDNM))+TPAY
76 .. I L+3>IOSL D HDR Q:$G(SDABRT)=1
77 .. W !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
78 .. W ?60,$$FMTE^XLFDT($P(SDWHO,"^",2),"5Z")
79 .. W ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
80 .. W ?105,$J(TCHRG,10,2),?115,$J(TPAY,10,2)
81 .. S L=L+1
82 I $G(SDABRT)=1 Q
83 ;
84 I L+6>IOSL D HDR I $G(SDABRT)=1 Q
85 W !,$TR($J(" ",IOM)," ","-"),!
86 W !,"TOTAL FIRST PARTY: ",?105,$J(FTOTB,10,2),?115,$J(FTOTP,10,2),!!
87 S L=L+5
88 ; Print Third Party
89 S SDOE=""
90 F S SDOE=$O(^TMP($J,"SDSCBILL","THIRD",SDOE)) Q:SDOE="" D Q:$G(SDABRT)=1
91 . S BILN=""
92 . F S BILN=$O(^TMP($J,"SDSCBILL","THIRD",SDOE,BILN)) Q:BILN="" D Q:$G(SDABRT)=1
93 .. S SDBTR=^TMP($J,"SDSCBILL","THIRD",SDOE,BILN)
94 .. S TPAY=$P(SDBTR,U,3)
95 .. S AUTHDT=$P(SDBTR,U,2)\1
96 .. S SDWHO=$$SVCC(SDOE)
97 .. S PYMDT=$P(SDBTR,U,4)
98 .. S SDSCD=$G(^SDSC(409.48,SDOE,0))
99 .. S ENCDT=$P(SDSCD,U,7)\1
100 .. S DFN=$P(SDSCD,U,11)
101 .. D DEM^VADPT S SDPAT=$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
102 .. S TCHRG=$P(SDBTR,U)
103 .. S GTOTB=GTOTB+TCHRG,GTOTP=GTOTP+TPAY,TTOTB=TTOTB+TCHRG,TTOTP=TTOTP+TPAY
104 .. S DTTOTB(SDSCDNM)=$G(DTTOTB(SDSCDNM))+TCHRG,DTTOTP(SDSCDNM)=$G(DTTOTP(SDSCDNM))+TPAY
105 .. I L+3>IOSL D HDR Q:$G(SDABRT)=1
106 .. W !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
107 .. W ?60,$$FMTE^XLFDT($P(SDWHO,"^",2),"5Z")
108 .. W ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
109 .. W ?105,$J(TCHRG,10,2),?115,$J(TPAY,10,2)
110 .. S L=L+1
111 I $G(SDABRT)=1 Q
112 ;
113 I L+6>IOSL D HDR I $G(SDABRT)=1 Q
114 W !,$TR($J(" ",IOM)," ","-"),!
115 W !,"TOTAL THIRD PARTY: ",?105,$J(TTOTB,10,2),?115,$J(TTOTP,10,2),!!
116 S L=L+5
117 I L+6>IOSL D HDR I $G(SDABRT)=1 Q
118 W !,$TR($J(" ",IOM)," ","-"),!
119 W !,"TOTAL FOR BOTH: ",?105,$J(GTOTB,10,2),?115,$J(GTOTP,10,2),!!
120 S L=L+5
121 Q
122 ;
123FPCK ;Check for First Party Bill
124 N SCBLNS,SCARTR
125 S SCBLNS=$$FPBILL^IBRSUTL(SDOE) I (SCBLNS="")!($P(SCBLNS,U))="" Q
126 S SCARTR=$$GETDATA^PRCAAPI($P(SCBLNS,U)) I SCARTR="" Q
127 S $P(SCARTR,U,5)=$P(SCBLNS,U,3)
128 S ^TMP($J,"SDSCBILL","COPAY",SDOE,$P(SCBLNS,U))=SCARTR
129 Q
130 ;
131TPCK ;Check for Third Party Bill
132 N SCBLNS,SCBID,SCARTR,SCI
133 S SCBLNS=$$TPBILL^IBRSUTL(SDOE) I SCBLNS="" Q
134 F SCI=1:1 S SCBID=$P(SCBLNS,U,SCI) Q:SCBID="" D
135 . S SCARTR=$$GETDATA^PRCAAPI(SCBID)
136 . I SCARTR="" Q
137 . S ^TMP($J,"SDSCBILL","THIRD",SDOE,SCBID)=SCARTR
138 Q
139 ;
140HDR ; Header
141 ; Do not ask 'RETURN' before first page on CRT.
142 I $E(IOST,1,2)="C-",P D I 'Y S SDABRT=1 Q
143 .N DIR S DIR(0)="E" D ^DIR
144 ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
145 I $E(IOST,1,2)="C-"!P W @IOF
146 S P=P+1,L=4
147 W "Recovered Costs Report by Division: "_SDSCDNM_" ",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
148 W !,"Enc #",?10,"Patient",?45,"Enc Date",?60,"Change Date",?75,"Auth Date",?90,"Pay Date",?105,"Prncpl Bill",?117,"Prncpl Pay"
149 W !,$TR($J(" ",IOM)," ","-"),!
150 Q
151 ;
152EXT ;
153 N L,TOTALB,TOTALP,DIV
154 I CT>1,$G(SDABRT)'=1 D
155 . I $E(IOST,1,2)="C-",P N DIR S DIR(0)="E" D ^DIR I 'Y S SDABRT=1 Q
156 . ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
157 . I $E(IOST,1,2)="C-"!P W @IOF
158 . S P=P+1,L=4,TOTALB=0,TOTALP=0
159 . I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
160 . W "Recovered Costs Report",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
161 . W !,"By Division(s) "_THDR
162 . W !,?105,"Prncpl Bill",?117,"Prncpl Pay"
163 . W !,$TR($J(" ",IOM)," ","-"),!
164 . W !,?10,"FIRST PARTY TOTAL"
165 . S DIV="" F S DIV=$O(DFTOTB(DIV)) Q:DIV="" D
166 .. W !,?30,DIV,?105,$J(DFTOTB(DIV),10,2),?115,$J(DFTOTP(DIV),10,2)
167 .. S TOTALB=TOTALB+DFTOTB(DIV),TOTALP=TOTALP+DFTOTP(DIV)
168 . W !,$TR($J(" ",IOM)," ","-"),!
169 . W !,?10,"THIRD PARTY TOTAL"
170 . S DIV="" F S DIV=$O(DTTOTB(DIV)) Q:DIV="" D
171 .. W !,?30,DIV,?105,$J(DTTOTB(DIV),10,2),?115,$J(DTTOTP(DIV),10,2)
172 .. S TOTALB=TOTALB+DTTOTB(DIV),TOTALP=TOTALP+DTTOTP(DIV)
173 . W !,$TR($J(" ",IOM)," ","-"),!
174 . W !,?10,"TOTAL FOR BOTH FIRST AND THIRD PARTY",?105,$J(TOTALB,10,2),?115,$J(TOTALP,10,2)
175 D RPTEND^SDSCRPT1
176 ;
177EXIT ; Exit tag
178 K SDQFL,SDRUN,SDEDT,SDOE,SDOEDT,SDSCTDT,SDSCBDT,SDSCEDT,POP,SDABRT,BILL
179 K BILT,FIND,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,SCLN D KVA^VADPT
180 K ^TMP($J,"SDSCBILL")
181 Q
182 ;
183SVCC(SDENC) ; Service Connected Last Edit Change
184 ;
185 ; Input:
186 ; SDENC = Encounter IEN
187 ;
188 ; Output:
189 ; Function = "" - (null if undefined)
190 ; = EDITED BY_"^"_DATE EDITED - (WHO^WHEN)
191 ;
192 N SDJ,SDVAL,SDX
193 S SDVAL="",SDJ=999999
194 S SDJ=$O(^SDSC(409.48,SDENC,1,SDJ),-1)
195 I SDJ D
196 . S SDX=$G(^SDSC(409.48,SDENC,1,SDJ,0))
197 . I $P(SDX,U,5)=0 D
198 . . S SDVAL=$P(SDX,U,3)_"^"_$P(SDX,U,2)
199 Q SDVAL
Note: See TracBrowser for help on using the repository browser.