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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1IBCNBOF ;ALB/ARH-Ins Buffer: Employee Report (Entered);1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82**;21-MAR-94
3 ;
4EN ;get parameters then run the report
5 ;
6 K ^TMP($J) D HOME^%ZIS S IBHDR="INSURANCE BUFFER EMPLOYEE REPORT" W @IOF,!!,?25,IBHDR
7 W !!,"This report produces a count of the number of entries added to the Buffer",!,"file for a specified date range sorted by employee. Also included are",!,"sub-totals and percentages based on the current status of those entries."
8 ;
9 S IBEMPL=+$$EMPL^IBCNBOE G:IBEMPL="" EXIT W !!
10 I +IBEMPL S IBEMPL=$$SELEMPL^IBCNBOE("Enters/Creates") G:IBEMPL="" EXIT W !!
11 ;
12 S IBBEG=$$DATES^IBCNBOE("Beginning") G:'IBBEG EXIT
13 S IBEND=$$DATES^IBCNBOE("Ending",IBBEG) G:'IBEND EXIT W !!
14 ;
15 S IBMONTH=$$MONTH^IBCNBOE G:IBMONTH="" EXIT W !!
16 ;
17DEV ;get the device
18 W !,"Report requires 132 columns."
19 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
20 I $D(IO("Q")) S ZTRTN="RPT^IBCNBOF",ZTDESC=IBHDR,ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
21 U IO
22 ;
23RPT ; run report
24 S IBQUIT=0
25 ;
26 D SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL) G:IBQUIT EXIT
27 D PRINT(IBBEG,IBEND,IBMONTH,IBEMPL)
28 ;
29EXIT K ^TMP($J),IBHDR,IBBEG,IBEND,IBMONTH,IBQUIT,IBEMPL
30 Q:$D(ZTQUEUED)
31 D ^%ZISC
32 Q
33 ;
34SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL) ; search/sort statistics for employee report
35 N IBXDT,IBBUFDA,IBB0,IBXREF,IBS1,IBEMP
36 S IBBEG=$G(IBBEG)-.01,IBEND=$S('$G(IBEND):9999999,1:$P(IBEND,".")+.9)
37 ;
38 S IBXDT=IBBEG F S IBXDT=$O(^IBA(355.33,"B",IBXDT)) Q:'IBXDT!(IBXDT>IBEND) D S IBQUIT=$$STOP Q:IBQUIT
39 . S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"B",IBXDT,IBBUFDA)) Q:'IBBUFDA D
40 .. ;
41 .. S IBB0=$G(^IBA(355.33,IBBUFDA,0)),IBEMP=+$P(IBB0,U,2) I 'IBEMP Q
42 .. I +IBEMPL,IBEMPL'=IBEMP Q
43 .. ;
44 .. I $G(IBMONTH) D SET("IBCNBOF",IBEMP,$E(+IBB0,1,5),$P(IBB0,U,4),+$P(IBB0,U,7),+$P(IBB0,U,8),+$P(IBB0,U,9))
45 .. D SET("IBCNBOF",IBEMP,99999,$P(IBB0,U,4),+$P(IBB0,U,7),+$P(IBB0,U,8),+$P(IBB0,U,9))
46 .. D SET("IBCNBOF","~",99999,$P(IBB0,U,4),+$P(IBB0,U,7),+$P(IBB0,U,8),+$P(IBB0,U,9))
47 ;
48 Q
49 ;
50SET(XREF,S1,S2,STAT,NC,NG,NP) ;
51 S ^TMP($J,XREF,S1,S2,"CNT")=$G(^TMP($J,XREF,S1,S2,"CNT"))+1
52 I STAT="E" S ^TMP($J,XREF,S1,S2,"EN")=$G(^TMP($J,XREF,S1,S2,"EN"))+1
53 I STAT="R" S ^TMP($J,XREF,S1,S2,"RJ")=$G(^TMP($J,XREF,S1,S2,"RJ"))+1
54 I STAT="A" S ^TMP($J,XREF,S1,S2,"AC")=$G(^TMP($J,XREF,S1,S2,"AC"))+1
55 I +NC S ^TMP($J,XREF,S1,S2,"NC")=$G(^TMP($J,XREF,S1,S2,"NC"))+1
56 I +NG S ^TMP($J,XREF,S1,S2,"NG")=$G(^TMP($J,XREF,S1,S2,"NG"))+1
57 I +NP S ^TMP($J,XREF,S1,S2,"NP")=$G(^TMP($J,XREF,S1,S2,"NP"))+1
58 Q
59 ;
60 ;
61PRINT(IBBEG,IBEND,IBMONTH,IBEMPL) ;
62 N IBXREF,IBS1,IBS2,IBRDT,IBPGN,IBRANGE,IBLN,IBI
63 ;
64 S IBRANGE=$$FMTE^XLFDT(IBBEG)_" - "_$$FMTE^XLFDT(IBEND)
65 S IBRDT=$$FMTE^XLFDT($J($$NOW^XLFDT,0,4),2),IBRDT=$TR(IBRDT,"@"," "),IBPGN=0
66 D HDR
67 ;
68 S IBXREF="IBCNBOF",IBS1="" F S IBS1=$O(^TMP($J,IBXREF,IBS1)) Q:IBS1="" D
69 . I +$G(IBMONTH) W ! S IBLN=IBLN+1
70 . ;
71 . S IBS2=0 F S IBS2=$O(^TMP($J,IBXREF,IBS1,IBS2)) Q:IBS2="" D:IBLN>(IOSL-3) HDR Q:IBQUIT D
72 .. D PRTLN S IBLN=IBLN+1
73 Q
74 ;
75PRTLN ;
76 N IBEMP,IBCNT,IBEN,IBAC,IBRJ,IBNC,IBNG,IBNP,DATM
77 ;
78 S IBEMP=$P($G(^VA(200,+IBS1,0)),U,1) I IBS1="~" S IBEMP="TOTAL"
79 S IBCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,"CNT")) Q:'IBCNT
80 S IBEN=$G(^TMP($J,IBXREF,IBS1,IBS2,"EN"))
81 S IBAC=$G(^TMP($J,IBXREF,IBS1,IBS2,"AC"))
82 S IBRJ=$G(^TMP($J,IBXREF,IBS1,IBS2,"RJ"))
83 S IBNC=$G(^TMP($J,IBXREF,IBS1,IBS2,"NC"))
84 S IBNG=$G(^TMP($J,IBXREF,IBS1,IBS2,"NG"))
85 S IBNP=$G(^TMP($J,IBXREF,IBS1,IBS2,"NP"))
86 S DATM=$S(IBS2=99999:"TOTAL",1:$$FMTE^XLFDT(IBS2_"00"))
87 ;
88 W !,$E(IBEMP,1,15),?17,DATM,?25,$J($FN(IBCNT,","),7)
89 W ?35,$J($FN(IBEN,","),7),?43,$J("("_$FN(((IBEN/IBCNT)*100),",",1)_"%)",8)
90 W ?54,$J($FN(IBAC,","),7),?62,$J("("_$FN(((IBAC/IBCNT)*100),",",1)_"%)",8)
91 W ?73,$J($FN(IBRJ,","),7),?81,$J("("_$FN(((IBRJ/IBCNT)*100),",",1)_"%)",8)
92 W ?92,$J($FN(IBNC,","),7),?102,$J($FN(IBNG,","),7),?112,$J($FN(IBNP,","),7)
93 Q
94 ;
95HDR ;print the report header
96 S IBQUIT=$$STOP Q:IBQUIT
97 I IBPGN>0 S IBQUIT=$$PAUSE Q:IBQUIT
98 S IBPGN=IBPGN+1,IBLN=5 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
99 W !,"INSURANCE BUFFER (ENTERING) EMPLOYEE REPORT ",IBRANGE," "
100 W ?(IOM-22),IBRDT,?(IOM-7)," PAGE ",IBPGN,!,?39,"NOT YET",?93,"NEW",?104,"NEW",?113,"NEW"
101 W !,"EMPLOYEE",?17,"MONTH",?27,"TOTAL",?39,"PROCESSED",?58,"ACCEPTED",?77,"REJECTED",?93,"INS CO",?104,"GROUP",?113,"POLICY",!
102 S IBI="",$P(IBI,"-",IOM+1)="" W IBI
103 Q
104 ;
105PAUSE() ;pause at end of screen if beeing displayed on a terminal
106 N IBX,DIR,DIRUT,DUOUT,X,Y S IBX=0
107 I $E(IOST,1,2)["C-" W !! S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBX=1
108 Q IBX
109 ;
110STOP() ;determine if user has requested the queued report to stop
111 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
112 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.