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

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

initial load of FOIAVistA 6/30/08 version

File size: 8.7 KB
Line 
1IBCNBOE ;ALB/ARH-Ins Buffer: Employee Report ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82**;21-MAR-94
3 ;
4EN ;get parameters then run the report
5 N IBX S IBX=$$WR Q:'IBX I IBX=1 G ^IBCNBOF ; WHICH REPORT? entered or processed
6 ;
7 ;
8 K ^TMP($J) D HOME^%ZIS S IBHDR="INSURANCE BUFFER INSURANCE EMPLOYEE REPORT" W @IOF,!!,?17,IBHDR
9 W !!,"This report produces counts and time statistics for Insurance Employees that",!,"have either Verified or Processed (Accept/Reject) an Insurance Buffer entry.",!!
10 ;
11 S IBEMPL=$$EMPL G:IBEMPL="" EXIT W !!
12 ;
13 I +IBEMPL S IBEMPL=$$SELEMPL("Verifies or Processes") G:IBEMPL="" EXIT W !!
14 ;
15 S IBBEG=$$DATES("Beginning") G:'IBBEG EXIT
16 S IBEND=$$DATES("Ending",IBBEG) G:'IBEND EXIT W !!
17 ;
18 S IBMONTH=$$MONTH G:IBMONTH="" EXIT W !!
19 ;
20DEV ;get the device
21 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
22 I $D(IO("Q")) S ZTRTN="RPT^IBCNBOE",ZTDESC=IBHDR,ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
23 U IO
24 ;
25RPT ; run report
26 S IBQUIT=0
27 ;
28 D SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL) G:IBQUIT EXIT
29 D PRINT(IBBEG,IBEND,IBEMPL)
30 ;
31EXIT K ^TMP($J),IBHDR,IBBEG,IBEND,IBMONTH,IBQUIT,IBEMPL
32 Q:$D(ZTQUEUED)
33 D ^%ZISC
34 Q
35 ;
36SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL) ; search/sort statistics for activity report
37 N IBXST,IBXDT,IBBUFDA,IBB0,IBDATE,IBEMP,IBTIME,IBSTAT,IBDT2,IBVER,IBS3 S IBQUIT=""
38 S IBBEG=$G(IBBEG)-.01,IBEND=$S('$G(IBEND):9999999,1:$P(IBEND,".")+.9)
39 ;
40 F IBXST="A","R","V" D Q:IBQUIT
41 . S IBXDT=IBBEG F S IBXDT=$O(^IBA(355.33,"AFST",IBXST,IBXDT)) Q:'IBXDT!(IBXDT>IBEND) D S IBQUIT=$$STOP Q:IBQUIT
42 .. S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AFST",IBXST,IBXDT,IBBUFDA)) Q:'IBBUFDA D
43 ... ;
44 ... S IBB0=$G(^IBA(355.33,IBBUFDA,0))
45 ... ;
46 ... ; verified
47 ... I IBXST="V" S IBDATE=+$P(IBB0,U,10) I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
48 .... S IBEMP=+$P(IBB0,U,11) I +IBEMPL,IBEMPL'=IBEMP Q
49 .... S IBTIME=$$FMDIFF^XLFDT(IBDATE,+IBB0,2),IBSTAT="VERIFIED",IBS3=1
50 .... D SET(IBSTAT,IBEMP,$E(IBDATE,1,5),IBS3,IBTIME,IBB0,$G(IBMONTH))
51 ... ;
52 ... ; processed
53 ... I IBXST="A"!(IBXST="R") S IBDATE=+$P(IBB0,U,5) I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
54 .... S IBEMP=+$P(IBB0,U,6) I +IBEMPL,IBEMPL'=IBEMP Q
55 .... S IBVER=$P(IBB0,U,10),IBSTAT="UNKNOWN",IBS3=6
56 .... S IBDT2=$S(+IBVER:+IBVER,1:+IBB0),IBTIME=$$FMDIFF^XLFDT(IBDATE,+IBDT2,2)
57 .... ;
58 .... I $P(IBB0,U,4)="A" S IBS3=2,IBSTAT="ACCEPTED" I 'IBVER S IBS3=3,IBSTAT=IBSTAT_" (&V)"
59 .... I $P(IBB0,U,4)="R" S IBS3=4,IBSTAT="REJECTED" I +IBVER S IBS3=5,IBSTAT=IBSTAT_" (V)"
60 .... D SET(IBSTAT,IBEMP,$E(IBDATE,1,5),IBS3,IBTIME,IBB0,$G(IBMONTH))
61 ;
62 Q
63 ;
64SET(STAT,IBEMP,IBDATE,S3,TIME,IBB0,IBMONTH) ;
65 I +$G(IBMONTH) D SET1(IBSTAT,IBEMP,$E(IBDATE,1,5),S3,IBTIME,IBB0)
66 D SET1(IBSTAT,IBEMP,99999,S3,IBTIME,IBB0)
67 D SET1(IBSTAT,"~",99999,S3,IBTIME,IBB0)
68 Q
69 ;
70SET1(STAT,S1,S2,S3,TIME,IBB0) ;
71 ;
72 D TMP("IBCNBOE",S1,S2,S3,TIME,STAT)
73 D TMP("IBCNBOE",S1,S2,9,TIME,"TOTAL")
74 ;
75 Q:$E(STAT)'="A"
76 ;
77 D TMP1("IBCNBOEC",S1,S2,+$P(IBB0,U,7),+$P(IBB0,U,8),+$P(IBB0,U,9))
78 Q
79 ;
80TMP(XREF,S1,S2,S3,TIME,NAME) ;
81 S ^TMP($J,XREF,S1,S2,S3)=NAME
82 S ^TMP($J,XREF,S1,S2,S3,"CNT")=$G(^TMP($J,XREF,S1,S2,S3,"CNT"))+1
83 S ^TMP($J,XREF,S1,S2,S3,"TM")=$G(^TMP($J,XREF,S1,S2,S3,"TM"))+TIME
84 I '$G(^TMP($J,XREF,S1,S2,S3,"HG"))!($G(^TMP($J,XREF,S1,S2,S3,"HG"))<TIME) S ^TMP($J,XREF,S1,S2,S3,"HG")=TIME
85 I '$G(^TMP($J,XREF,S1,S2,S3,"LS"))!($G(^TMP($J,XREF,S1,S2,S3,"LS"))>TIME) S ^TMP($J,XREF,S1,S2,S3,"LS")=TIME
86 Q
87 ;
88TMP1(XREF,S1,S2,IC,GC,PC) ;
89 I +IC S ^TMP($J,XREF,S1,S2,"I")=$G(^TMP($J,XREF,S1,S2,"I"))+1
90 I +GC S ^TMP($J,XREF,S1,S2,"G")=$G(^TMP($J,XREF,S1,S2,"G"))+1
91 I +PC S ^TMP($J,XREF,S1,S2,"P")=$G(^TMP($J,XREF,S1,S2,"P"))+1
92 S ^TMP($J,XREF,S1,S2,"CNT")=$G(^TMP($J,XREF,S1,S2,"CNT"))+1
93 Q
94 ;
95 ;
96 ;
97PRINT(IBBEG,IBEND,IBEMPL) ;
98 N IBXREF,IBLABLE,IBS1,IBS2,IBS3,IBINS,IBGRP,IBPOL,IBCNT,IBIP,IBGP,IBPP,IBRDT,IBPGN,IBRANGE,IBLN,IBI
99 ;
100 S IBRANGE=$$FMTE^XLFDT(IBBEG)_" - "_$$FMTE^XLFDT(IBEND)
101 S IBRDT=$$FMTE^XLFDT($J($$NOW^XLFDT,0,4),2),IBRDT=$TR(IBRDT,"@"," "),IBPGN=0
102 D HDR
103 ;
104 S IBXREF="IBCNBOE",IBS1="" F S IBS1=$O(^TMP($J,IBXREF,IBS1)) Q:IBS1="" D
105 . ;
106 . S IBS2=0 F S IBS2=$O(^TMP($J,IBXREF,IBS1,IBS2)) Q:IBS2="" D:IBLN>(IOSL-15) HDR Q:IBQUIT D S IBLN=IBLN+8
107 .. S IBLABLE=$S(IBS2=99999:"TOTALS",($E(IBBEG,1,5)<IBS2)&($E(IBEND,1,5)>IBS2):$$FMTE^XLFDT(IBS2_"00"),1:"")
108 .. I IBLABLE="" S IBLABLE=$$FMTE^XLFDT($S($E(IBBEG,1,5)<IBS2:IBS2_1,1:IBBEG))_" - "_$$FMTE^XLFDT($S($E(IBEND,1,5)>IBS2:$$SCH^XLFDT("1M(L)",IBS2_11),1:IBEND))
109 .. S IBLABLE=$P($G(^VA(200,IBS1,0)),U,1)_" "_IBLABLE
110 .. W !,?(40-($L(IBLABLE)/2)),IBLABLE,!
111 .. W !,?43,"AVERAGE",?56,"LONGEST",?68,"SHORTEST"
112 .. W !,"STATUS",?22,"COUNT",?30,"PERCENT",?43,"# DAYS",?56,"# DAYS",?68,"# DAYS"
113 .. W !,"-----------------------------------------------------------------------------"
114 .. ;
115 .. S IBS3="" F S IBS3=$O(^TMP($J,IBXREF,IBS1,IBS2,IBS3)) Q:'IBS3 D PRTLN S IBLN=IBLN+1
116 .. ;
117 .. S IBINS=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"I")),IBGRP=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"G"))
118 .. S IBPOL=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"P")),IBCNT=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"CNT"))
119 .. S (IBIP,IBGP,IBPP)=0 I IBCNT'=0 S IBIP=((IBINS/IBCNT)*100)\1,IBGP=((IBGRP/IBCNT)*100)\1,IBPP=((IBPOL/IBCNT)*100)\1
120 .. W !!,?2,IBINS," New Compan",$S(IBINS=1:"y",1:"ies")," (",IBIP,"%), "
121 .. W IBGRP," New Group/Plan",$S(IBGRP=1:"",1:"s")," (",IBGP,"%), "
122 .. W IBPOL," New Patient Polic",$S(IBPOL=1:"y",1:"ies")," (",IBPP,"%)",!
123 ;
124 S IBI=$$PAUSE
125 Q
126 ;
127PRTLN ;
128 N IBSTX,IBCNT,IBTM,IBHG,IBLS,IBTCNT
129 ;
130 S IBSTX=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3))
131 S IBCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"CNT")) Q:'IBCNT
132 S IBTM=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"TM"))
133 S IBHG=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"HG"))
134 S IBLS=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"LS"))
135 S IBTCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,9,"CNT")) Q:'IBTCNT
136 ;
137 W !,IBSTX,?20,$J($FN(IBCNT,","),7),?30,$J(((IBCNT/IBTCNT)*100),6,1),"%",?43,$J($$STD((IBTM/IBCNT)),6,1),?56,$J($$STD(IBHG),6,1),?68,$J($$STD(IBLS),6,1)
138 Q
139 ;
140STD(SEC) ; convert seconds to days
141 N IBX,IBD,IBS,IBH,DAYS S DAYS="" G:'$G(SEC) STDQ
142 S IBD=(SEC/86400),IBD=+$P(IBD,".")
143 S IBS=SEC-(IBD*86400)
144 S IBH=((IBS/60)/60),IBH=+$J(IBH,0,2)
145 S DAYS=IBD+(IBH/24)
146STDQ Q DAYS
147 ;
148HDR ;print the report header
149 S IBQUIT=$$STOP Q:IBQUIT
150 I IBPGN>0 S IBQUIT=$$PAUSE Q:IBQUIT
151 S IBPGN=IBPGN+1,IBLN=5 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
152 W !,"INSURANCE BUFFER EMPLOYEE REPORT ",IBRANGE," "
153 W ?(IOM-22),IBRDT,?(IOM-7)," PAGE ",IBPGN,!
154 I +$G(IBEMPL) W !,"EMPLOYEE: ",$P($G(^VA(200,+IBEMPL,0)),U,1),!
155 S IBI="",$P(IBI,"-",IOM+1)="" W IBI,!
156 Q
157 ;
158PAUSE() ;pause at end of screen if beeing displayed on a terminal
159 N IBX,DIR,DIRUT,X,Y S IBX=0
160 I $E(IOST,1,2)["C-" W !! S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBX=1
161 Q IBX
162 ;
163STOP() ;determine if user has requested the queued report to stop
164 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
165 Q +$G(ZTSTOP)
166 ;
167WR() ; which report
168 N DIR,X,Y,DIRUT,DUOUT,IBX S IBX=""
169 S DIR("?")="Enter 'V' for a report based on employees that verify or process (accept/reject) buffer entries."
170 S DIR("?",5)="Enter 'E' for a report based on employees that create new buffer entries."
171 S DIR("?",1)="This report may be printed for those employees that create Buffer entries,"
172 S DIR("?",2)="primarily non-Insurance personnel or for those employees that verify and process",DIR("?",3)="(accept/reject) Buffer entries, primarily Insurance Personnel.",DIR("?",4)=" "
173 S DIR("A")="Include which Type of Employee",DIR(0)="SO^1:Entered By;2:Verified/Processed By" D ^DIR
174 S IBX=$S(Y>0:+Y,1:"")
175 Q IBX
176 ;
177EMPL() ; print a single or all employees?
178 N DIR,X,Y,DIRUT,DUOUT,IBX S IBX=""
179 S DIR("?",1)="Report of activity in the Buffer file by Employee and date range."
180 S DIR("?",2)="Enter 'S' to include only a single employee in the report."
181 S DIR("?")="Enter 'A' to include all employees in the report."
182 S DIR("A")="Include Selected or All Employees"
183 S DIR("B")="All",DIR(0)="SO^A:All Employees;S:Selected Employee" D ^DIR
184 S IBX=$S(Y="S":1,Y="A":0,1:"")
185 Q IBX
186 ;
187SELEMPL(TYPE) ; get the name of an employee
188 N DIC,X,Y,DTOUT,DUOUT,IBX S IBX=""
189 S DIC("A")="Select an Employee that "_TYPE_" Buffer entries: "
190 S DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC S IBX=+Y I $D(DTOUT)!$D(DUOUT)!(Y<1) S IBX=""
191 Q IBX
192 ;
193DATES(LABLE,IBBEG) ;
194 N DIR,X,Y,DIRUT,DUOUT,IBX,IBB,IBD S IBX="",IBB=$P($S(+$G(IBBEG):IBBEG,1:+$O(^IBA(355.33,"B",0))),"."),IBD=$S(+$G(IBBEG):DT,1:IBB)
195 S DIR("?")="Enter the "_LABLE_" date to include in the report."
196 S DIR("?",1)="Enter a date from the date of the first Buffer entry to today."
197 S DIR("A")=LABLE_" Date",DIR("B")=$$FMTE^XLFDT(IBD)
198 S DIR(0)="DO^"_IBB_":"_DT_":EX" D ^DIR S IBX=Y I $D(DIRUT)!$D(DUOUT) S IBX=""
199 Q IBX
200 ;
201MONTH() ;
202 N DIR,X,Y,DIRUT,DUOUT,IBX S IBX=""
203 S DIR("?")="Enter No if only totals for the date range should be reported."
204 S DIR("?",1)="Enter Yes if the report should be broken down by month."
205 S DIR("A")="Report By Month",DIR(0)="Y",DIR("B")="No" D ^DIR
206 S IBX=$S(Y=1:Y,Y=0:Y,1:"")
207 Q IBX
Note: See TracBrowser for help on using the repository browser.