source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDSCRPT1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 7.7 KB
Line 
1SDSCRPT1 ;ALB/JAM/RBS - ASCD Reports for Service Connected Automated Monitor ; 4/24/07 4:30pm
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 ; Routine should be called at specified tags only.
7 Q
8RDPOV ; 'ROUTINE' tag called by option "SDSC ENC REPORT - Service Connected Encounters Report"
9 N ZTDESC,SDRTN,SDOPT,DIR,DIRUT,X,Y
10 W !,"Service Connected Encounters Report"
11 S DIR(0)="SO^S:Service Connected;N:Non-Service Connected;A:All"
12 S DIR("B")="S",DIR("A")="Which option do you want to run?"
13 D ^DIR I $D(DIRUT) Q
14 S SDOPT=$S(Y="S":1,Y="N":0,1:2)
15 S ZTDESC="COMPARE DISABILITY/POV PER ENCOUNTER",SDRTN="PRINT^SDSCRPT1"
16 G LOAD
17 ;
18NSCCOP ; 'ROUTINE' tag called by option "SDSC FIRST PARTY REPORT - First Party Billable Service Connected Report"
19 N ZTDESC,SDRTN
20 S ZTDESC="SERVICE CONNECTED CO-PAY REPORT",SDRTN="COPPRT^SDSCRPT1"
21 G LOAD
22 ;
23NSCINS ; 'ROUTINE' tag called by option "SDSC THIRD PARTY REPORT - Third Party Billable Service Connected Report"
24 N ZTDESC,SDRTN
25 S ZTDESC="SERVICE CONNECTED BILLING INSURANCE REPORT",SDRTN="INSPRT^SDSCRPT1"
26 G LOAD
27 ;
28SCPRV ;Provider Service Connected Encounters Report
29 N SDDET,DIR,DIRUT,X,Y,ZTDESC,SDRTN
30 W !,"Provider Service Connected Encounters Report"
31 S DIR(0)="SO^D:Detail;S:Summary",DIR("B")="S"
32 S DIR("A")="Which option do you want to run?"
33 D ^DIR I $D(DIRUT) Q
34 S SDDET=$S(Y="D":1,1:0)
35 S ZTDESC="SERV CONN REVIEW REPORT BY PROVIDER",SDRTN="PRVPRT^SDSCRPT1"
36 G LOAD
37 ;
38SCUSR ;User Service Connected Encounters Report
39 N SDDET,DIR,DIRUT,X,Y,ZTDESC,SDRTN
40 W !,"User Service Connected Encounters Report"
41 S DIR(0)="SO^D:Detail;S:Summary",DIR("B")="S"
42 S DIR("A")="Which option do you want to run?"
43 D ^DIR I $D(DIRUT) Q
44 S SDDET=$S(Y="D":1,1:0)
45 S ZTDESC="SERV CONN REVIEW REPORT BY USER",SDRTN="RVWPRT^SDSCRPT1"
46 G LOAD
47 ;
48LOAD ; Standard start tag for all current reports.
49 ; Initialize variables if necessary.
50 N ZTIO,ZTSAVE,ZTRTN,P,L,SDABRT
51 K %ZIS D HOME^%ZIS
52 ; Select division
53 D DIV I SDQFL G END
54 ; Get start and end date for report.
55 D GETDATE^SDSCOMP I SDSCTDT="" G END
56 ; Initialize page counts
57 S (P,L,SDABRT)=0
58 ; Prompt user for DEVICE and handle TaskMan queuing if required.
59 S %ZIS="QM" D ^%ZIS G END:POP
60 I '$D(IO("Q")) U IO K ZTDESC G LOOP
61 S ZTIO=ION,ZTSAVE("*")="",ZTRTN="LOOP^SDSCRPT1" D ^%ZTLOAD
62 G END
63LOOP ; Loop through each division and display the selected report.
64 N CT,SDSCDIV,SDSCDNM,SDI,THDR
65 S CT=0,SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
66 I SDSCDIV="" S SDSCDNM="ALL" D @SDRTN
67 I SDSCDIV'="" D
68 . S THDR=""
69 . F SDI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",SDI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
70 .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D @SDRTN
71 D RPTEND
72 G END
73 ;
74PRINT ; Display the encounters previously stored for this date.
75 ; This is a detailed report, set flag
76 N SDDET,SDOEDT,SDOE,SCVAL
77 S SDDET=1
78 U IO D HEADER^SDSCRPT2 I $G(SDABRT)=1 Q
79 ; Loop through all encounters found in that date range.
80 S SDOEDT=SDSCTDT F S SDOEDT=$O(^SDSC(409.48,"AE",SDOEDT)) Q:SDOEDT\1>SDEDT Q:SDOEDT="" D Q:$G(SDABRT)=1
81 . S SDOE=0 F S SDOE=$O(^SDSC(409.48,"AE",SDOEDT,SDOE)) Q:'SDOE D Q:$G(SDABRT)=1
82 .. I $G(SDSCDIV)'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
83 .. ; Get data
84 .. I '$$STDGET Q
85 .. S SCVAL=$P(^SDSC(409.48,SDOE,0),U,6)
86 .. I $S(SCVAL=SDOPT:1,SDOPT=2:1,1:0) D
87 ... D ENCBDDT^SDSCRPT2
88 Q
89 ;
90INSPRT ;Display all encounters that may be billable to insurance.
91 N SDHDR,SDOEDT,SDOE,SCVAL
92 S SDHDR="OUTPATIENT ENCOUNTERS POTENTIALLY BILLABLE TO INSURANCE"
93 U IO D NBILLHD^SDSCRPT2 I $G(SDABRT)=1 Q
94 ; Loop through all encounters found in that date range.
95 S SDOEDT=SDSCTDT F S SDOEDT=$O(^SDSC(409.48,"AE",SDOEDT)) Q:SDOEDT\1>SDEDT Q:SDOEDT="" D Q:$G(SDABRT)=1
96 . S SDOE=0 F S SDOE=$O(^SDSC(409.48,"AE",SDOEDT,SDOE)) Q:'SDOE D Q:$G(SDABRT)=1
97 .. I $G(SDSCDIV)'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
98 .. ; Get data
99 .. I '$$STDGET Q
100 .. ; Check for ability of patients insurance to be billed
101 .. I $$NBTP^SDSCUTL() Q
102 .. ; If Not Service Connected (NSC) after reviews, print.
103 .. S SCVAL=$$SCHNG^SDSCUTL(SDOE) I '+SCVAL Q
104 .. I '($P(SCVAL,U,3)) D NBILLBD^SDSCRPT2
105 Q
106 ;
107COPPRT ;Display all encounters that may be billable for co-payment.
108 N SDHDR,SDOEDT,SDOE,SDVAL
109 S SDHDR="OUTPATIENT ENCOUNTERS POTENTIALLY BILLABLE FOR CO-PAYS"
110 U IO D NBILLHD^SDSCRPT2 I $G(SDABRT)=1 Q
111 ; Loop through all encounters found in that date range.
112 S SDOEDT=SDSCTDT F S SDOEDT=$O(^SDSC(409.48,"AE",SDOEDT)) Q:SDOEDT\1>SDEDT Q:SDOEDT="" D Q:$G(SDABRT)=1
113 . S SDOE=0 F S SDOE=$O(^SDSC(409.48,"AE",SDOEDT,SDOE)) Q:'SDOE D Q:$G(SDABRT)=1
114 .. I $G(SDSCDIV)'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
115 .. ; Get data
116 .. I '$$STDGET Q
117 .. ; Check for patients ability to be billed
118 .. I $$NBFP^SDSCUTL(SDOE) Q
119 .. ; If Not Service Connected (NSC) after reviews, print.
120 .. S SDVAL=$$SCHNG^SDSCUTL(SDOE) I '+SDVAL Q
121 .. I '$P(SDVAL,U,3) D NBILLBD^SDSCRPT2
122 Q
123 ;
124RVWPRT ;Display all User Reviewed encounters
125 ;SDDET=1 - Detailed Report; SDDET=0 - Summary Report
126 N SDHDR,SDLEB,SDNWPV,SDPVCN,SDPCT,SDOEDT,SDOE
127 S SDHDR="OUTPATIENT ENCOUNTERS SERVICE CONNECTED REVIEW BY USER"
128 U IO D RVWHD^SDSCRPT2 I $G(SDABRT)=1 Q
129 ; Loop through all encounters found in that date range.
130 S SDLEB=0 F S SDLEB=$O(^SDSC(409.48,"AG",SDLEB)) Q:'SDLEB D Q:$G(SDABRT)=1
131 . ; Reset flag to print provider name
132 . S SDNWPV=1,SDPVCN=0,SDPCT=0
133 . S SDOEDT=SDSCTDT F S SDOEDT=$O(^SDSC(409.48,"AG",SDLEB,SDOEDT)) Q:SDOEDT\1>SDEDT Q:SDOEDT="" D Q:$G(SDABRT)=1
134 .. S SDOE=0 F S SDOE=$O(^SDSC(409.48,"AG",SDLEB,SDOEDT,SDOE)) Q:'SDOE D Q:$G(SDABRT)=1
135 ... I $G(SDSCDIV)'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
136 ... ; Get data
137 ... I '$$STDGET Q
138 ... S SDPCT=SDPCT+1
139 ... D RVWBD^SDSCRPT2
140 . I SDPCT'=0 W ?3,"Total: "_SDPCT,! S L=L+1 Q
141 Q
142 ;
143PRVPRT ;Display all User Reviewed encounters by Provider
144 ;SDDET=1 - Detailed Report; SDDET=0 - Summary Report
145 N SDHDR,SDPROV,SDNWPV,SDPVCN,SDPCT,SDOE,SDOEDT
146 S SDHDR="OUTPATIENT ENCOUNTERS SERVICE CONNECTED REVIEW BY PROVIDER"
147 U IO D PRVHD^SDSCRPT2 I $G(SDABRT)=1 Q
148 ; Loop through all encounters found in that date range.
149 S SDPROV=0 F S SDPROV=$O(^SDSC(409.48,"AF",SDPROV)) Q:'SDPROV D Q:$G(SDABRT)=1
150 . ; Reset flag to print provider name, without the continued label.
151 . S SDNWPV=1,SDPVCN=0,SDPCT=0
152 . S SDOEDT=SDSCTDT F S SDOEDT=$O(^SDSC(409.48,"AF",SDPROV,SDOEDT)) Q:SDOEDT\1>SDEDT Q:SDOEDT="" D Q:$G(SDABRT)=1
153 .. S SDOE=0 F S SDOE=$O(^SDSC(409.48,"AF",SDPROV,SDOEDT,SDOE)) Q:'SDOE D Q:$G(SDABRT)=1
154 ... I $G(SDSCDIV)'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
155 ... ; Get data
156 ... I '$$STDGET Q
157 ... S SDPCT=SDPCT+1
158 ... D PRVBD^SDSCRPT2
159 . I SDPCT'=0 W ?3,"Total: "_SDPCT,! S L=L+1 Q
160 Q
161 ;
162RPTEND ;Report cleSDp.
163 I '$G(SDABRT) W !,"<End of Report>" I $E(IOST,1,2)="C-" D
164 .N DIR S DIR(0)="E" D ^DIR
165 I $G(SDABRT)=1 W !,"<Report Aborted>"
166 D ^%ZISC
167 I $D(ZTQUEUED) S ZTREQ="@"
168 Q
169 ;
170STDGET() ; All standard data retrieval from SD, Encounter and Visit.
171 ; Get compiled data
172 S SDDATA=$G(^SDSC(409.48,SDOE,0)) Q:SDDATA="" 0
173 ; Get encounter data
174 S SDOEDAT=$$GETOE^SDOE(SDOE) Q:SDOEDAT="" 0
175 ; Get patient
176 S SDPAT=$P(SDOEDAT,U,2) Q:SDPAT="" 0
177 ; Get clinic info
178 S SDCLIN=$P(SDOEDAT,U,4) Q:SDCLIN="" 0
179 ; Get clinic stop code info
180 S SDCST=$P(SDOEDAT,U,3) Q:SDCST="" 0
181 ; Retrieving the visit number, quit if no visit number found
182 S SDV0=$P(SDOEDAT,U,5) Q:SDV0="" 0
183 Q 1
184 ;
185END ; Clear all variables before exiting.
186 K SDSCTDT,SDEDT,SDFILEOK,X,X1,X2,Y,SDV0,SDDATA,SDPAT,SDCLIN,SDCST
187 K ZTQUEUED,ZTREQ,SDPOV,SDVPOV0,SDPROV,DTOUT,DUOUT,POP,SDSCBDT,SDSCEDT
188 K SDQFL,SDPCTS,SDSCDVSL,SDSCDVLN,SDRTN,SCLN,SDOEDAT
189 Q
190 ;
191DIV ; Ask Division
192 N DIR,X,Y
193 S SDQFL=0
194 D DIV^SDSCUTL
195 D ^DIR
196 I $G(DTOUT)!($G(DUOUT)) S SDQFL=1 Q
197 S SDSCDVSL=Y,SDSCDVLN=SCLN
198 Q
Note: See TracBrowser for help on using the repository browser.