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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1IBCNBOA ;ALB/ARH-Ins Buffer: Activity Report ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,305**;21-MAR-94
3 ;
4EN ;get parameters then run the report
5 ;
6 K ^TMP($J) D HOME^%ZIS S IBHDR="INSURANCE BUFFER ACTIVITY REPORT" W @IOF,!!,?25,IBHDR
7 W !!,"This report contains the counts and time statistics for all activity in the",!,"Insurance Buffer.",!!
8 ;
9 S IBBEG=$$DATES^IBCNBOE("Beginning") G:'IBBEG EXIT
10 S IBEND=$$DATES^IBCNBOE("Ending",IBBEG) G:'IBEND EXIT W !!
11 ;
12 S IBMONTH=$$MONTH^IBCNBOE G:IBMONTH="" EXIT W !!
13 ;
14DEV ;get the device
15 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
16 I $D(IO("Q")) S ZTRTN="RPT^IBCNBOA",ZTDESC=IBHDR,ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
17 U IO
18 ;
19RPT ; run report
20 S IBQUIT=0
21 ;
22 ;Patch 305- QUIT in line below inserted for transmission to ARC
23 D SEARCH(IBBEG,IBEND,IBMONTH) Q:$G(IBARFLAG) G:IBQUIT EXIT
24 D PRINT(IBBEG,IBEND)
25 ;
26EXIT K ^TMP($J),IBHDR,IBBEG,IBEND,IBMONTH,IBQUIT
27 Q:$D(ZTQUEUED)
28 D ^%ZISC
29 Q
30 ;
31SEARCH(IBBEG,IBEND,IBMONTH) ; search/sort statistics for activity report
32 N IBXST,IBXDT,IBBUFDA,IBB0,IBSTAT,IBTIME,IBS3,IBDATE,IBVER,IBDT2 S IBQUIT=""
33 S IBBEG=$G(IBBEG)-.01,IBEND=$S('$G(IBEND):9999999,1:$P(IBEND,".")+.9)
34 ;
35 S IBXST="" F S IBXST=$O(^IBA(355.33,"AFST",IBXST)) Q:IBXST="" D Q:IBQUIT
36 . S IBXDT=+IBBEG F S IBXDT=$O(^IBA(355.33,"AFST",IBXST,IBXDT)) Q:'IBXDT!(IBXDT>IBEND) D S IBQUIT=$$STOP Q:IBQUIT
37 .. S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AFST",IBXST,IBXDT,IBBUFDA)) Q:'IBBUFDA D
38 ... ;
39 ... S IBB0=$G(^IBA(355.33,IBBUFDA,0)),IBSTAT=$P(IBB0,U,4),IBVER=$P(IBB0,U,10)
40 ... ;
41 ... ; entered
42 ... I IBXST="E" S IBDATE=+IBB0 I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
43 .... S IBDT2=+$P(IBB0,U,10) I 'IBDT2 S IBDT2=+$P(IBB0,U,5) I 'IBDT2 S IBDT2=$$NOW^XLFDT
44 .... S IBTIME=+$$FMDIFF^XLFDT(IBDT2,IBDATE,2),IBSTAT="ENTERED",IBS3=1
45 .... I +$G(IBMONTH) D SET(IBSTAT,$E(IBDATE,1,5),IBS3,IBTIME,IBB0)
46 .... D SET(IBSTAT,99999,IBS3,IBTIME,IBB0)
47 ... ;
48 ... ; verified
49 ... I IBXST="V" S IBDATE=+$P(IBB0,U,10) I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
50 .... S IBTIME=+$$FMDIFF^XLFDT(IBDATE,+IBB0,2),IBSTAT="VERIFIED",IBS3=2
51 .... I +$G(IBMONTH) D SET(IBSTAT,$E(IBDATE,1,5),IBS3,IBTIME,IBB0)
52 .... D SET(IBSTAT,99999,IBS3,IBTIME,IBB0)
53 ... ;
54 ... ; processed
55 ... I IBXST="A"!(IBXST="R") S IBDATE=+$P(IBB0,U,5) I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
56 .... S IBDT2=+IBVER I 'IBVER S IBDT2=+IBB0
57 .... S IBTIME=+$$FMDIFF^XLFDT(IBDATE,+IBDT2,2),IBSTAT="UNKNOWN",IBS3=6
58 .... I $P(IBB0,U,4)="A" S IBS3=3,IBSTAT="ACCEPTED" I 'IBVER S IBS3=4,IBSTAT=IBSTAT_" (&V)"
59 .... I $P(IBB0,U,4)="R" S IBS3=5,IBSTAT="REJECTED" I +IBVER S IBS3=6,IBSTAT=IBSTAT_" (V)"
60 .... I +$G(IBMONTH) D SET(IBSTAT,$E(IBDATE,1,5),IBS3,IBTIME,IBB0)
61 .... D SET(IBSTAT,99999,IBS3,IBTIME,IBB0)
62 ;
63 Q
64 ;
65SET(STAT,S1,S3,TIME,IBB0) ;
66 D TMP("IBCNBOA",S1,1,S3,TIME,STAT)
67 I S3<3 D TMP("IBCNBOA",S1,2,1,TIME,"NOT PROCESSED")
68 I S3>2 D TMP("IBCNBOA",S1,2,2,TIME,"PROCESSED")
69 D TMP("IBCNBOA",S1,2,9,TIME,"TOTAL")
70 ;
71 Q:$E(STAT)'="A"
72 ;
73 D TMP1("IBCNBOAC",S1,+$P(IBB0,U,7),+$P(IBB0,U,8),+$P(IBB0,U,9))
74 Q
75 ;
76TMP(XREF,S1,S2,S3,TIME,NAME) ;
77 S ^TMP($J,XREF,S1,S2,S3)=NAME
78 S ^TMP($J,XREF,S1,S2,S3,"CNT")=$G(^TMP($J,XREF,S1,S2,S3,"CNT"))+1
79 S ^TMP($J,XREF,S1,S2,S3,"TM")=$G(^TMP($J,XREF,S1,S2,S3,"TM"))+TIME
80 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
81 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
82 Q
83 ;
84TMP1(XREF,S1,IC,GC,PC) ;
85 I +IC S ^TMP($J,XREF,S1,"I")=$G(^TMP($J,XREF,S1,"I"))+1
86 I +GC S ^TMP($J,XREF,S1,"G")=$G(^TMP($J,XREF,S1,"G"))+1
87 I +PC S ^TMP($J,XREF,S1,"P")=$G(^TMP($J,XREF,S1,"P"))+1
88 S ^TMP($J,XREF,S1,"CNT")=$G(^TMP($J,XREF,S1,"CNT"))+1
89 Q
90 ;
91 ;
92 ;
93PRINT(IBBEG,IBEND) ;
94 N IBXREF,IBLABLE,IBS1,IBS2,IBS3,IBINS,IBGRP,IBPOL,IBCNT,IBIP,IBGP,IBPP,IBRDT,IBPGN,IBRANGE,IBLN,IBI
95 ;
96 S IBRANGE=$$FMTE^XLFDT(+IBBEG)_" - "_$$FMTE^XLFDT(IBEND)
97 S IBRDT=$$FMTE^XLFDT($J($$NOW^XLFDT,0,4),2),IBRDT=$TR(IBRDT,"@"," "),IBPGN=0
98 D HDR
99 ;
100 S IBXREF="IBCNBOA",IBS1="" F S IBS1=$O(^TMP($J,IBXREF,IBS1)) Q:IBS1="" D:IBLN>(IOSL-17) HDR Q:IBQUIT D S IBLN=IBLN+7
101 . S IBLABLE=$S(IBS1=99999:"TOTALS",($E(IBBEG,1,5)<IBS1)&($E(IBEND,1,5)>IBS1):$$FMTE^XLFDT(IBS1_"00"),1:"")
102 . I IBLABLE="" S IBLABLE=$$FMTE^XLFDT($S($E(IBBEG,1,5)<IBS1:IBS1_1,1:IBBEG))_" - "_$$FMTE^XLFDT($S($E(IBEND,1,5)>IBS1:$$SCH^XLFDT("1M(L)",IBS1_11),1:IBEND))
103 . W !,?(40-($L(IBLABLE)/2)),IBLABLE,!
104 . W !,?43,"AVERAGE",?56,"LONGEST",?68,"SHORTEST"
105 . W !,"STATUS",?22,"COUNT",?30,"PERCENT",?43,"# DAYS",?56,"# DAYS",?68,"# DAYS"
106 . ;
107 . S IBS2=0 F S IBS2=$O(^TMP($J,IBXREF,IBS1,IBS2)) Q:IBS2="" D S IBLN=IBLN+1
108 .. W !,"-----------------------------------------------------------------------------"
109 .. S IBS3="" F S IBS3=$O(^TMP($J,IBXREF,IBS1,IBS2,IBS3)) Q:'IBS3 D PRTLN S IBLN=IBLN+1
110 . ;
111 . S IBINS=+$G(^TMP($J,"IBCNBOAC",IBS1,"I")),IBGRP=+$G(^TMP($J,"IBCNBOAC",IBS1,"G"))
112 . S IBPOL=+$G(^TMP($J,"IBCNBOAC",IBS1,"P")),IBCNT=+$G(^TMP($J,"IBCNBOAC",IBS1,"CNT"))
113 . S (IBIP,IBGP,IBPP)=0 I IBCNT'=0 S IBIP=((IBINS/IBCNT)*100)\1,IBGP=((IBGRP/IBCNT)*100)\1,IBPP=((IBPOL/IBCNT)*100)\1
114 . W !!,?2,IBINS," New Compan",$S(IBINS=1:"y",1:"ies")," (",IBIP,"%), "
115 . W IBGRP," New Group/Plan",$S(IBGRP=1:"",1:"s")," (",IBGP,"%), "
116 . W IBPOL," New Patient Polic",$S(IBPOL=1:"y",1:"ies")," (",IBPP,"%)",!
117 Q
118 ;
119PRTLN ;
120 N IBSTX,IBCNT,IBTM,IBHG,IBLS,IBTCNT
121 ;
122 S IBSTX=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3))
123 S IBCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"CNT")) Q:'IBCNT
124 S IBTM=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"TM"))
125 S IBHG=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"HG"))
126 S IBLS=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"LS"))
127 S IBTCNT=$G(^TMP($J,IBXREF,IBS1,2,9,"CNT")) Q:'IBTCNT
128 ;
129 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)
130 Q
131 ;
132STD(SEC) ; convert seconds to days
133 N IBX,IBD,IBS,IBH,DAYS S DAYS="" G:'$G(SEC) STDQ
134 S IBD=(SEC/86400),IBD=+$P(IBD,".")
135 S IBS=SEC-(IBD*86400)
136 S IBH=((IBS/60)/60),IBH=+$J(IBH,0,2)
137 S DAYS=IBD+(IBH/24)
138STDQ Q DAYS
139 ;
140HDR ;print the report header
141 S IBQUIT=$$STOP Q:IBQUIT
142 I IBPGN>0 S IBQUIT=$$PAUSE Q:IBQUIT
143 S IBPGN=IBPGN+1,IBLN=4 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
144 W !,"INSURANCE BUFFER ACTIVITY REPORT ",IBRANGE," "
145 W ?(IOM-22),IBRDT,?(IOM-7)," PAGE ",IBPGN,!
146 S IBI="",$P(IBI,"-",IOM+1)="" W IBI,!
147 Q
148 ;
149PAUSE() ;pause at end of screen if being displayed on a terminal
150 N IBX,DIR,DIRUT,X,Y S IBX=0
151 I $E(IOST,1,2)["C-" W !! S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBX=1
152 Q IBX
153 ;
154STOP() ;determine if user has requested the queued report to stop
155 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
156 Q +$G(ZTSTOP)
157 ;
158IBAR(IBBEG,IBEND) ;Entry point for Vista IB AR data to ARC
159 ;patch 305 - called by IBRFN4
160 N IBMONTH,IBARFLAG,IBARDATA,IBTM,IBCNT
161 S IBMONTH=0,IBARFLAG=1 K ^TMP($J)
162 D RPT
163 S IBTM=$G(^TMP($J,"IBCNBOA",99999,2,2,"TM"))
164 S IBCNT=$G(^TMP($J,"IBCNBOA",99999,2,2,"CNT"))
165 I 'IBCNT S IBARDATA=0 G IBARQ
166 S IBARDATA=$FN($$STD((IBTM/IBCNT)),"",1)
167 K ^TMP($J)
168IBARQ Q IBARDATA
Note: See TracBrowser for help on using the repository browser.