IBCNBOE ;ALB/ARH - Ins Buffer: Employee Report ; 1 Jun 97
;;2.0;INTEGRATED BILLING;**82,528,602,702**;21-MAR-94;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
EN ;get parameters then run the report
; IB*702/DTG start newed following variables
N IBBA,IBBB,IBBC,IBBD,IBBEG,IBBEGEX,IBBENEX,IBBUFEM,IBBUFEME,IBBUFSD,IBBUFSM,IBBUFSMD,IBBUFSME,IBCHGDT
N IBCO,IBCUR,IBCURFM,IBEDDT,IBEMPL,IBEND,IBHDR,IBL,IBLM,IBMONTH,IBOK,IBOUT,IBQUIT,IBSTDT,ZTQUEUED,ZTSTOP
N IBX
; IB*702/DTG end newed following variables
;
; IB*702/DTG start put report header before first question
I $G(IOF)="" D HOME^%ZIS
S IBHDR="INSURANCE BUFFER EMPLOYEE REPORT" W !!,?25,IBHDR
;
; IB*702/DTG start Change for up-caret response
ENA ; allow for up-caret responses
; N IBX S IBX=$$WR Q:'IBX I IBX=1 G ^IBCNBOF ; WHICH REPORT? entered or processed
S IBX=$$WR I 'IBX G EXIT ; WHICH REPORT? entered or processed
I IBX=1 G ^IBCNBOF
;
;
; IB*702/DTG start not have form feed between first and second prompt
;K ^TMP($J) I $G(IOF)="" D HOME^%ZIS
;S IBHDR="INSURANCE BUFFER INSURANCE EMPLOYEE REPORT" W @IOF,!!,?17,IBHDR
K ^TMP($J)
;S IBHDR="INSURANCE BUFFER INSURANCE EMPLOYEE REPORT" W !!,?17,IBHDR
; IB*702/DTG end put report header before first question
; IB*702/DTG end not have form feed between first and second prompt
;
; IB*702/DTG start remove verified from report
W !!,"This report produces counts and time statistics for Insurance Employees that"
;W !,"have either Verified or Processed (Accept/Reject) an Insurance Buffer entry.",!!
W !,"have Processed (Accept/Reject) an Insurance Buffer entry.",!!
; IB*702/DTG end remove verified from report
;
10 ; ask if all employees
S IBEMPL=$$EMPL I IBEMPL="" G:$$STOP^IBCNINSU EXIT G ENA
;
W !!
15 ; ask employee name
I +IBEMPL W ! S IBEMPL=$$SELEMPL("Processes") W:IBEMPL !! I IBEMPL="" G:$$STOP^IBCNINSU EXIT G 10
;
; IB*702/DTG start change of question flow
;
; S IBBEG=$$DATES("Beginning") G:'IBBEG EXIT
; S IBEND=$$DATES("Ending",IBBEG) G:'IBEND EXIT W !!
;
; S IBMONTH=$$MONTH^IBCNBOE G:IBMONTH="" EXIT W !!
;
;get current month/year
S IBCURFM=$E(DT,1,5),IBCUR=$$EXMON^IBCNBOA(IBCURFM)
;
20 ; ask if for month
S IBMONTH=$$MONTH I IBMONTH="" G:$$STOP^IBCNINSU EXIT G 15:+IBEMPL,10
S IBOK=$$MTHBASE^IBCNBOF(1)
I 'IBOK G:$$STOP^IBCNINSU EXIT G 15:+IBEMPL,10
S IBBUFSM=$P(IBOK,U,2)
;
209 ; come here for dates if going back
;
; month dates
I IBMONTH S (IBOK,IBCO)=0 D I 'IBOK G:IBCO=2 EXIT G 20
. D 22 I 'IBCO!(IBCO=2) Q
. S IBOK=1
;
; daily dates
I 'IBMONTH S (IBOK,IBCO)=0 D I 'IBOK G:IBCO=2 EXIT G 20
. D 25 I 'IBCO!(IBCO=2) Q
. S IBOK=1
;
W !!
;
; IB*702/DTG end change of question flow
;
30 ; ask type of report
S IBOUT=$$OUT I IBOUT="" G:$$STOP^IBCNINSU EXIT G 209
; IB*702/DTG start warn line length if excel
I IBOUT="E" W !!,"To avoid undesired wrapping, please enter '0;256;999' at the 'DEVICE:' prompt.",!
; IB*702/DTG end warn line length if excel
;
DEV ;get the device
N %ZIS,POP,ZTDESC,ZTRTN,ZTSAVE
;S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
S %ZIS="QM",%ZIS("A")="DEVICE: "
D ^%ZIS
I POP G:$$STOP^IBCNINSU EXIT G 30
; IB*702/DTG start keep IOM at 80 if report
I $E($G(IBOUT),1)="R" S IOM=80
; IB*702/DTG end keep IOM at 80 if report
I $D(IO("Q")) S ZTRTN="RPT^IBCNBOE",ZTDESC=IBHDR,ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
U IO
G RPT
;
22 ; starting month ; IB*702
;
; starting date
S IBCO=0,IBSTDT=$$IBSM^IBCNBOA("Beginning","")
I 'IBSTDT S:$$STOP^IBCNINSU IBCO=2 Q
S IBBEGEX=$P(IBSTDT,U,2),IBSTDT=$P(IBSTDT,U,1)
S IBBEG=IBSTDT_"01"
;
23 ; ending month ; IB*702
;
W !
S IBEDDT=$$IBSM^IBCNBOA("Ending",IBSTDT)
S IBBENEX=$P(IBEDDT,U,2),IBEDDT=$P(IBEDDT,U,1)
I 'IBEDDT G:'$$STOP^IBCNINSU 22 S IBCO=2 Q
S IBEND=$$LAST^IBAGMM(IBEDDT)
S IBCO=1
Q
;
25 ; starting date ; IB*702
;
S IBBEG=$$DATES^IBCNBOE("Beginning") I 'IBBEG S:$$STOP^IBCNINSU IBCO=2 Q
;
26 ; ending date ; IB*702
;
W !
S IBEND=$$DATES^IBCNBOE("Ending",IBBEG) I 'IBEND G:'$$STOP^IBCNINSU 25 S IBCO=2 Q
S IBCO=1
Q
;
; IB*702/DTG end Change for up-caret response
;
RPT ; run report
S IBQUIT=0
;
D SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL) G:IBQUIT EXIT
D PRINT(IBBEG,IBEND,IBEMPL,IBOUT)
;
EXIT K ^TMP($J),IBBA,IBBB,IBBC,IBBD,IBBEG,IBBEGEX,IBBENEX,IBBUFEM,IBBUFEME,IBBUFSD,IBBUFSM,IBBUFSMD,IBBUFSME,IBCHGDT
K IBCO,IBCUR,IBCURFM,IBEDDT,IBEMPL,IBEND,IBHDR,IBL,IBLM,IBMONTH,IBOK,IBOUT,IBQUIT,IBSTDT,IBX
Q:$D(ZTQUEUED)
D ^%ZISC
Q
;
SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL) ; search/sort statistics for activity report
N IBXST,IBXDT,IBBUFDA,IBB0,IBDATE,IBEMP,IBTIME,IBSTAT,IBDT2,IBVER,IBS3 S IBQUIT=""
S IBBEG=$G(IBBEG)-.01,IBEND=$S('$G(IBEND):9999999,1:$P(IBEND,".")+.9)
;
; IB*702/DTG start remove verified from report
; F IBXST="A","R","V" D Q:IBQUIT
F IBXST="A","R" D Q:IBQUIT
. S IBXDT=IBBEG F S IBXDT=$O(^IBA(355.33,"AFST",IBXST,IBXDT)) Q:'IBXDT!(IBXDT>IBEND) D S IBQUIT=$$STOP Q:IBQUIT
.. S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AFST",IBXST,IBXDT,IBBUFDA)) Q:'IBBUFDA D
... ;
... S IBB0=$G(^IBA(355.33,IBBUFDA,0))
... ;
... ; verified
... ;I IBXST="V" S IBDATE=+$P(IBB0,U,10) I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
...;. S IBEMP=+$P(IBB0,U,11) I +IBEMPL,IBEMPL'=IBEMP Q
...;. S IBTIME=$$FMDIFF^XLFDT(IBDATE,+IBB0,2),IBSTAT="VERIFIED",IBS3=1
...;. D SET(IBSTAT,IBEMP,$E(IBDATE,1,5),IBS3,IBTIME,IBB0,$G(IBMONTH))
...; IB*702/DTG end remove verified from report
... ;
... ; processed
... I IBXST="A"!(IBXST="R") S IBDATE=+$P(IBB0,U,5) I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
.... S IBEMP=+$P(IBB0,U,6) I +IBEMPL,IBEMPL'=IBEMP Q
.... S IBVER=$P(IBB0,U,10),IBSTAT="UNKNOWN",IBS3=6
.... S IBDT2=$S(+IBVER:+IBVER,1:+IBB0),IBTIME=$$FMDIFF^XLFDT(IBDATE,+IBDT2,2)
.... ;
.... ; IB*702/DTG start remove &V and V
.... ;I $P(IBB0,U,4)="A" S IBS3=2,IBSTAT="ACCEPTED" I 'IBVER S IBS3=3,IBSTAT=IBSTAT_" (&V)"
.... ;I $P(IBB0,U,4)="R" S IBS3=4,IBSTAT="REJECTED" I +IBVER S IBS3=5,IBSTAT=IBSTAT_" (V)"
.... I $P(IBB0,U,4)="A" S IBS3=2,IBSTAT="ACCEPTED"
.... I $P(IBB0,U,4)="R" S IBS3=4,IBSTAT="REJECTED"
.... ; IB*702/DTG end remove &V and V
.... D SET(IBSTAT,IBEMP,$E(IBDATE,1,5),IBS3,IBTIME,IBB0,$G(IBMONTH))
;
Q
;
SET(STAT,IBEMP,IBDATE,S3,TIME,IBB0,IBMONTH) ;
I +$G(IBMONTH) D SET1(IBSTAT,IBEMP,$E(IBDATE,1,5),S3,IBTIME,IBB0)
D SET1(IBSTAT,IBEMP,99999,S3,IBTIME,IBB0)
D SET1(IBSTAT,"~",99999,S3,IBTIME,IBB0)
Q
;
SET1(STAT,S1,S2,S3,TIME,IBB0) ;
;
D TMP("IBCNBOE",S1,S2,S3,TIME,STAT)
D TMP("IBCNBOE",S1,S2,9,TIME,"TOTAL")
;
Q:$E(STAT)'="A"
;
D TMP1("IBCNBOEC",S1,S2,+$P(IBB0,U,7),+$P(IBB0,U,8),+$P(IBB0,U,9))
Q
;
TMP(XREF,S1,S2,S3,TIME,NAME) ;
S ^TMP($J,XREF,S1,S2,S3)=NAME
S ^TMP($J,XREF,S1,S2,S3,"CNT")=$G(^TMP($J,XREF,S1,S2,S3,"CNT"))+1
S ^TMP($J,XREF,S1,S2,S3,"TM")=$G(^TMP($J,XREF,S1,S2,S3,"TM"))+TIME
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
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
; IB*702/DTG start call set stubs for item entries.
D TMPCHK(XREF,S1,S2,S3,TIME,NAME)
; IB*702/DTG end call set stubs for item entries.
Q
;
; IB*702/DTG start set stubs for item entries.
TMPCHK(XREF,S1,S2,S3,TIME,NAME) ; check if not there set stub for all if one is set
; use S1 (emp) and S2 (date), S3 1, 2, 4, 9
N IBBI
F IBBI=2,4,9 I $G(^TMP($J,XREF,S1,S2,IBBI))="" D
. S ^TMP($J,XREF,S1,S2,IBBI)=$P(",ACCEPTED,,REJECTED,,,,,TOTAL",",",IBBI)
. S ^TMP($J,XREF,S1,S2,IBBI,"CNT")=""
. S ^TMP($J,XREF,S1,S2,IBBI,"TM")=""
. I $G(^TMP($J,XREF,S1,S2,IBBI,"HG"))="" S ^TMP($J,XREF,S1,S2,IBBI,"HG")=""
. I $G(^TMP($J,XREF,S1,S2,IBBI,"LS"))="" S ^TMP($J,XREF,S1,S2,IBBI,"LS")=""
Q
; IB*702/DTG end set stubs for item entries.
;
TMP1(XREF,S1,S2,IC,GC,PC) ;
I +IC S ^TMP($J,XREF,S1,S2,"I")=$G(^TMP($J,XREF,S1,S2,"I"))+1
I +GC S ^TMP($J,XREF,S1,S2,"G")=$G(^TMP($J,XREF,S1,S2,"G"))+1
I +PC S ^TMP($J,XREF,S1,S2,"P")=$G(^TMP($J,XREF,S1,S2,"P"))+1
S ^TMP($J,XREF,S1,S2,"CNT")=$G(^TMP($J,XREF,S1,S2,"CNT"))+1
Q
;
;
;
PRINT(IBBEG,IBEND,IBEMPL,IBOUT) ;
N IBXREF,IBLABLE,IBEMPN,IBS1,IBS2,IBS3,IBINS,IBGRP,IBPOL,IBCNT,IBIP,IBGP,IBPP,IBRDT,IBPGN,IBRANGE,IBLN,IBI
;
; IB*702/DTG start stop push of line on screen up
N MAXCNT,CRT
S MAXCNT=IOSL-8
; IB*702/DTG end stop push of line on screen up
I "^R^E^"'[(U_$G(IBOUT)_U) S IBOUT="R"
S IBRANGE=$$FMTE^XLFDT(IBBEG)_" - "_$$FMTE^XLFDT(IBEND)
S IBRDT=$$FMTE^XLFDT($J($$NOW^XLFDT,0,4),2),IBRDT=$TR(IBRDT,"@"," "),(IBLN,IBPGN)=0
; IB*702/DTG start Combine vars, no data check, end of report
S IBXREF="IBCNBOE",IBS1=""
;
D HDR:IBOUT="R",PHDL:IBOUT="E"
I '$D(^TMP($J,IBXREF)) D Q
. W ! W:$G(IBOUT)="R" ?((IOM\2)-17) W "* * * N O D A T A F O U N D * * *",!
. D EOR^IBCNBOF(IOM)
. S IBI=$$PAUSE
;
;
; Excel output
I IBOUT="E" D S IBI=$$PAUSE Q
. ;S IBXREF="IBCNBOE",IBS1="" F S IBS1=$O(^TMP($J,IBXREF,IBS1)) Q:IBS1="" D
. F S IBS1=$O(^TMP($J,IBXREF,IBS1)) D:IBS1="" EOR(132) Q:IBS1="" D
.. S IBS2=0 F S IBS2=$O(^TMP($J,IBXREF,IBS1,IBS2)) Q:IBS2="" D
... D GETLABL
... S IBS3="" F S IBS3=$O(^TMP($J,IBXREF,IBS1,IBS2,IBS3)) Q:'IBS3 D PRTLN
... ;
... D GETOAC
... W U_IBINS_U_IBIP_"%"_U_IBGRP_U_IBGP_"%"_U_IBPOL_U_IBPP_"%"
;
; Report Section
;D HDR
;
;S IBXREF="IBCNBOE",IBS1="" F S IBS1=$O(^TMP($J,IBXREF,IBS1)) Q:IBS1="" D Q:IBQUIT
F S IBS1=$O(^TMP($J,IBXREF,IBS1)) D:IBS1="" EOR(80) Q:IBS1="" D Q:IBQUIT
. ;
. ;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
. S IBS2=0 F S IBS2=$O(^TMP($J,IBXREF,IBS1,IBS2)) Q:IBS2="" D:IBLN+8>MAXCNT HDR Q:IBQUIT D S IBLN=IBLN+8 ; IB*702/DTG
.. D GETLABL
.. W !,?(40-($L(IBLABLE)/2)),IBLABLE,!
.. W !,?43,"AVERAGE",?56,"LONGEST",?68,"SHORTEST"
.. W !,"STATUS",?22,"COUNT",?30,"PERCENT",?43,"# DAYS",?56,"# DAYS",?68,"# DAYS"
.. W !,"-----------------------------------------------------------------------------"
.. ;
.. S IBS3="" F S IBS3=$O(^TMP($J,IBXREF,IBS1,IBS2,IBS3)) Q:'IBS3 D PRTLN S IBLN=IBLN+1
.. ;
.. D GETOAC
.. W !!,?2,IBINS," New Compan",$S(IBINS=1:"y",1:"ies")," (",IBIP,"%), "
.. W IBGRP," New Group/Plan",$S(IBGRP=1:"",1:"s")," (",IBGP,"%), "
.. W IBPOL," New Patient Polic",$S(IBPOL=1:"y",1:"ies")," (",IBPP,"%)",!
;
I 'IBQUIT S IBI=$$PAUSE
Q
;
; IB*702/DTG start Combine parts for excel and report
;
GETLABL ; pick up common values for Excel and Report
;
S IBLABLE=$S(IBS2=99999:"TOTALS",($E(IBBEG,1,5)<IBS2)&($E(IBEND,1,5)>IBS2):$$FMTE^XLFDT(IBS2_"00"),1:"")
I IBLABLE="" D ;<
. S IBLABLE=$$FMTE^XLFDT($S($E(IBBEG,1,5)<IBS2:IBS2_"01",1:IBBEG))_" - "_$$FMTE^XLFDT($S($E(IBEND,1,5)>IBS2:$$SCH^XLFDT("1M(L)",IBS2_11),1:IBEND))
. I $G(IBMONTH)&(IBLABLE["-") S IBLABLE=$$FMTE^XLFDT(IBS2_"00")
S IBEMPN=$P($G(^VA(200,IBS1,0)),U,1)
I IBOUT="R" S IBLABLE=IBEMPN_" "_IBLABLE
Q
;
GETOAC ; pick up items for IBCNBOEC
;
S IBINS=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"I")),IBGRP=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"G"))
S IBPOL=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"P")),IBCNT=+$G(^TMP($J,"IBCNBOEC",IBS1,IBS2,"CNT"))
S (IBIP,IBGP,IBPP)=0 I IBCNT'=0 S IBIP=((IBINS/IBCNT)*100)\1,IBGP=((IBGRP/IBCNT)*100)\1,IBPP=((IBPOL/IBCNT)*100)\1
Q
;
EOR(IBLE) ; write end of report
I '$G(IBLE) S IBLE=80
I IBLN>MAXCNT D HDR Q:IBQUIT
W ! W:$G(IBOUT)="R" ?((IBLE\2)-10) W "*** END OF REPORT ***"
Q
;
; IB*702/DTG end Combine parts for excel and report
;
PRTLN ; IB*702 Rewrote tag to print zeros for statuses with no counts
N IBSTX,IBCNT,IBTM,IBHG,IBLS,IBTCNT
;
N IBBA,IBBB,IBBC
;
S IBSTX=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3))
;S IBCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"CNT")) Q:'IBCNT ;IB*702 removed quit
S IBCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"CNT"))
S IBTM=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"TM"))
S IBHG=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"HG"))
S IBLS=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"LS"))
;S IBTCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,9,"CNT")) Q:'IBTCNT ;IB*702 removed quit
S IBTCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,9,"CNT"))
;
; Excel output
I IBOUT="E" D Q
. W !,IBEMPN_U_IBLABLE_U_IBSTX_U_$FN(IBCNT,",")_U
. S IBBA=$S((IBCNT'=""&(IBTCNT'="")):((IBCNT/IBTCNT)*100),1:0),IBBC=$$EXN^IBCNBOF(IBBA) W IBBC_"%"_U
. S IBBA=$S(IBCNT'="":$$STD((IBTM/IBCNT)),1:0),IBBC=$$EXN^IBCNBOF(IBBA) W IBBC_U
. S IBBA=$$STD(IBHG),IBBC=$$EXN^IBCNBOF(IBBA) W IBBC_U
. S IBBA=$$STD(IBLS),IBBC=$$EXN^IBCNBOF(IBBA) W IBBC
;
; Report output
W !,IBSTX,?20,$J($FN(IBCNT,","),7)
S IBBA=$S((IBCNT'=""&(IBTCNT'="")):((IBCNT/IBTCNT)*100),1:0) W ?30,$J(IBBA,6,1),"%"
S IBBA=$S(IBCNT'="":$$STD((IBTM/IBCNT)),1:0) W ?43,$J(IBBA,6,1)
W ?56,$J($$STD(IBHG),6,1),?68,$J($$STD(IBLS),6,1)
Q
;
STD(SEC) ; convert seconds to days
N IBX,IBD,IBS,IBH,DAYS S DAYS="" G:'$G(SEC) STDQ
S IBD=(SEC/86400),IBD=+$P(IBD,".")
S IBS=SEC-(IBD*86400)
S IBH=((IBS/60)/60),IBH=+$J(IBH,0,2)
S DAYS=IBD+(IBH/24)
STDQ Q DAYS
;
HDR ;print the report header
S IBQUIT=$$STOP Q:IBQUIT
I IBPGN>0 S IBQUIT=$$PAUSE Q:IBQUIT
S IBPGN=IBPGN+1,IBLN=5 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
; IB*702/DTG start change INSURANCE to INS
;W !,"INSURANCE BUFFER EMPLOYEE REPORT ",IBRANGE," "
W !,"INS BUFFER EMPLOYEE REPORT ",IBRANGE," "
;W ?(IOM-22),IBRDT,?(IOM-7)," PAGE ",IBPGN,!
W ?(IOM-23),IBRDT,?(IOM-8),"PAGE ",IBPGN,!
I +$G(IBEMPL) W !,"EMPLOYEE: ",$P($G(^VA(200,+IBEMPL,0)),U,1),!
S IBI="",$P(IBI,"-",IOM+1)="" W IBI,!
Q
;
PHDL ; - Print the header line for the Excel spreadsheet
N X
; IB*602/HN ; Add report headers to Excel Spreadsheets
;W !,"INSURANCE BUFFER EMPLOYEE REPORT^"_IBRANGE_"^"_$$FMTE^XLFDT($$NOW^XLFDT,1),!
W !,"INS BUFFER EMPLOYEE REPORT^"_IBRANGE_"^"_$$FMTE^XLFDT($$NOW^XLFDT,1),!
I +$G(IBEMPL) W "EMPLOYEE: ",$P($G(^VA(200,+IBEMPL,0)),U,1),!
; IB*602/HN end
S X="EMPLOYEE^MONTH^STATUS^COUNT^PERCENT^AVERAGE # DAYS^LONGEST # DAYS^SHORTEST # DAYS^New Companies^"
S X=X_"% New Companies^New Group/Plans^% New Group/Plans^New Patient Policies^% New Patient Policies"
W X
K X
Q
; IB*702/DTG end change INSURANCE to INS
;
PAUSE() ;pause at end of screen if beeing displayed on a terminal
N IBX,DIR,DIRUT,X,Y S IBX=0
I $E(IOST,1,2)["C-" W !! S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBX=1
Q IBX
;
STOP() ;determine if user has requested the queued report to stop
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
Q +$G(ZTSTOP)
;
WR() ; which report
; IB*702/DTG start remove verified from report
N DIR,X,Y,DIRUT,DUOUT,IBX S IBX=""
;S DIR("?")="Enter 'V' for a report based on employees that verify or process (accept/reject) buffer entries."
S DIR("?")="Enter 'P' for a report based on employees that process (accept/reject) buffer entries."
S DIR("?",5)="Enter 'E' for a report based on employees that create new buffer entries."
S DIR("?",1)="This report may be printed for those employees that create Buffer entries,"
;S DIR("?",2)="primarily non-Insurance personnel or for those employees that verify and process"
S DIR("?",2)="primarily non-Insurance personnel or for those employees that process"
S DIR("?",3)="(accept/reject) Buffer entries, primarily Insurance Personnel."
S DIR("?",4)=" "
;S DIR("A")="Include which Type of Employee",DIR(0)="SO^1:Entered By;2:Verified/Processed By" D ^DIR
S DIR("A")="Include which Type of Employee",DIR(0)="SO^1:Entered By;2:Processed By"
D ^DIR
S IBX=$S(Y>0:+Y,1:"")
Q IBX
; IB*702/DTG end remove verified from report
;
EMPL() ; print a single or all employees?
N DIR,X,Y,DIRUT,DUOUT,IBX S IBX=""
S DIR("?",1)="Report of activity in the Buffer file by Employee and date range."
S DIR("?",2)="Enter 'S' to include only a single employee in the report."
S DIR("?")="Enter 'A' to include all employees in the report."
S DIR("A")="Include Selected or All Employees"
S DIR("B")="All",DIR(0)="SO^A:All Employees;S:Selected Employee" D ^DIR
S IBX=$S(Y="S":1,Y="A":0,1:"")
Q IBX
;
SELEMPL(TYPE) ; get the name of an employee
N DIC,X,Y,DTOUT,DUOUT,IBX S IBX=""
S DIC("A")="Select an Employee that "_TYPE_" Buffer entries: "
S DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC S IBX=+Y I $D(DTOUT)!$D(DUOUT)!(Y<1) S IBX=""
Q IBX
;
DATES(LABLE,IBBEG) ;
N DIR,DIRUT,DTOUT,DUOUT,IBX,IBB,IBD,IBE,X,Y
; IB*702/DTG start update date prompt & "?" text
S IBBEG=$G(IBBEG)
S IBX="",IBB=$P($S(+$G(IBBEG):IBBEG,1:+$O(^IBA(355.33,"B",0))),"."),IBD=$S(+$G(IBBEG):DT,1:IBB)
I IBBEG'="" S IBE="Beginning Date ("_$$FMTE^XLFDT(IBBEG)_")"
I IBBEG="" W !! S IBE="date of the first Buffer entry ("_$$FMTE^XLFDT(IBB)_")"
DATES1 ;Repeat for ending date outside of range
S DIR("?")="Enter the "_LABLE_" date to include in the report."
S DIR("?",1)="Enter a date from the "_IBE_" to today."
S DIR("A")=LABLE_" Date"
S DIR(0)="DO^::EX" D ^DIR
S IBX=Y
I Y="" W *7,!,"Enter the "_LABLE_" Date or '^' to Quit.",! G DATES1
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT) S IBX=""
I 'IBX G DATESX
I (IBX<IBB) W *7,!,"Date cannot be less than the "_IBE_".",! G DATES1
I (IBX>DT) W *7,!,"Date cannot be greater than Today.",! G DATES1
;
DATESX ;Exit Dates setup
Q IBX
;
MONTH() ;
N DIR,X,Y,DIRUT,DUOUT,IBX S IBX=""
; IB*702/DTG start update month prompt & "?" text
S DIR("?")="include the current month. Enter '^' to quit"
S DIR("?",1)="Answer YES if you'd like to see totals for previous months."
S DIR("?",2)="Answer NO if you'd like to see data on a selected date range which may"
S DIR("A")="Report Previous Completed Month(s)",DIR(0)="Y",DIR("B")="No" D ^DIR
; IB*702/DTG end update month prompt & "?" text
S IBX=$S(Y=1:Y,Y=0:Y,1:"")
Q IBX
;
OUT() ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR I $D(DIRUT) Q ""
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBOE 18120 printed Nov 22, 2024@17:24:17 Page 2
IBCNBOE ;ALB/ARH - Ins Buffer: Employee Report ; 1 Jun 97
+1 ;;2.0;INTEGRATED BILLING;**82,528,602,702**;21-MAR-94;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ;get parameters then run the report
+1 ; IB*702/DTG start newed following variables
+2 NEW IBBA,IBBB,IBBC,IBBD,IBBEG,IBBEGEX,IBBENEX,IBBUFEM,IBBUFEME,IBBUFSD,IBBUFSM,IBBUFSMD,IBBUFSME,IBCHGDT
+3 NEW IBCO,IBCUR,IBCURFM,IBEDDT,IBEMPL,IBEND,IBHDR,IBL,IBLM,IBMONTH,IBOK,IBOUT,IBQUIT,IBSTDT,ZTQUEUED,ZTSTOP
+4 NEW IBX
+5 ; IB*702/DTG end newed following variables
+6 ;
+7 ; IB*702/DTG start put report header before first question
+8 IF $GET(IOF)=""
DO HOME^%ZIS
+9 SET IBHDR="INSURANCE BUFFER EMPLOYEE REPORT"
WRITE !!,?25,IBHDR
+10 ;
+11 ; IB*702/DTG start Change for up-caret response
ENA ; allow for up-caret responses
+1 ; N IBX S IBX=$$WR Q:'IBX I IBX=1 G ^IBCNBOF ; WHICH REPORT? entered or processed
+2 ; WHICH REPORT? entered or processed
SET IBX=$$WR
IF 'IBX
GOTO EXIT
+3 IF IBX=1
GOTO ^IBCNBOF
+4 ;
+5 ;
+6 ; IB*702/DTG start not have form feed between first and second prompt
+7 ;K ^TMP($J) I $G(IOF)="" D HOME^%ZIS
+8 ;S IBHDR="INSURANCE BUFFER INSURANCE EMPLOYEE REPORT" W @IOF,!!,?17,IBHDR
+9 KILL ^TMP($JOB)
+10 ;S IBHDR="INSURANCE BUFFER INSURANCE EMPLOYEE REPORT" W !!,?17,IBHDR
+11 ; IB*702/DTG end put report header before first question
+12 ; IB*702/DTG end not have form feed between first and second prompt
+13 ;
+14 ; IB*702/DTG start remove verified from report
+15 WRITE !!,"This report produces counts and time statistics for Insurance Employees that"
+16 ;W !,"have either Verified or Processed (Accept/Reject) an Insurance Buffer entry.",!!
+17 WRITE !,"have Processed (Accept/Reject) an Insurance Buffer entry.",!!
+18 ; IB*702/DTG end remove verified from report
+19 ;
10 ; ask if all employees
+1 SET IBEMPL=$$EMPL
IF IBEMPL=""
if $$STOP^IBCNINSU
GOTO EXIT
GOTO ENA
+2 ;
+3 WRITE !!
15 ; ask employee name
+1 IF +IBEMPL
WRITE !
SET IBEMPL=$$SELEMPL("Processes")
if IBEMPL
WRITE !!
IF IBEMPL=""
if $$STOP^IBCNINSU
GOTO EXIT
GOTO 10
+2 ;
+3 ; IB*702/DTG start change of question flow
+4 ;
+5 ; S IBBEG=$$DATES("Beginning") G:'IBBEG EXIT
+6 ; S IBEND=$$DATES("Ending",IBBEG) G:'IBEND EXIT W !!
+7 ;
+8 ; S IBMONTH=$$MONTH^IBCNBOE G:IBMONTH="" EXIT W !!
+9 ;
+10 ;get current month/year
+11 SET IBCURFM=$EXTRACT(DT,1,5)
SET IBCUR=$$EXMON^IBCNBOA(IBCURFM)
+12 ;
20 ; ask if for month
+1 SET IBMONTH=$$MONTH
IF IBMONTH=""
if $$STOP^IBCNINSU
GOTO EXIT
if +IBEMPL
GOTO 15
GOTO 10
+2 SET IBOK=$$MTHBASE^IBCNBOF(1)
+3 IF 'IBOK
if $$STOP^IBCNINSU
GOTO EXIT
if +IBEMPL
GOTO 15
GOTO 10
+4 SET IBBUFSM=$PIECE(IBOK,U,2)
+5 ;
209 ; come here for dates if going back
+1 ;
+2 ; month dates
+3 IF IBMONTH
SET (IBOK,IBCO)=0
Begin DoDot:1
+4 DO 22
IF 'IBCO!(IBCO=2)
QUIT
+5 SET IBOK=1
End DoDot:1
IF 'IBOK
if IBCO=2
GOTO EXIT
GOTO 20
+6 ;
+7 ; daily dates
+8 IF 'IBMONTH
SET (IBOK,IBCO)=0
Begin DoDot:1
+9 DO 25
IF 'IBCO!(IBCO=2)
QUIT
+10 SET IBOK=1
End DoDot:1
IF 'IBOK
if IBCO=2
GOTO EXIT
GOTO 20
+11 ;
+12 WRITE !!
+13 ;
+14 ; IB*702/DTG end change of question flow
+15 ;
30 ; ask type of report
+1 SET IBOUT=$$OUT
IF IBOUT=""
if $$STOP^IBCNINSU
GOTO EXIT
GOTO 209
+2 ; IB*702/DTG start warn line length if excel
+3 IF IBOUT="E"
WRITE !!,"To avoid undesired wrapping, please enter '0;256;999' at the 'DEVICE:' prompt.",!
+4 ; IB*702/DTG end warn line length if excel
+5 ;
DEV ;get the device
+1 NEW %ZIS,POP,ZTDESC,ZTRTN,ZTSAVE
+2 ;S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
+3 SET %ZIS="QM"
SET %ZIS("A")="DEVICE: "
+4 DO ^%ZIS
+5 IF POP
if $$STOP^IBCNINSU
GOTO EXIT
GOTO 30
+6 ; IB*702/DTG start keep IOM at 80 if report
+7 IF $EXTRACT($GET(IBOUT),1)="R"
SET IOM=80
+8 ; IB*702/DTG end keep IOM at 80 if report
+9 IF $DATA(IO("Q"))
SET ZTRTN="RPT^IBCNBOE"
SET ZTDESC=IBHDR
SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
KILL IO("Q")
GOTO EXIT
+10 USE IO
+11 GOTO RPT
+12 ;
22 ; starting month ; IB*702
+1 ;
+2 ; starting date
+3 SET IBCO=0
SET IBSTDT=$$IBSM^IBCNBOA("Beginning","")
+4 IF 'IBSTDT
if $$STOP^IBCNINSU
SET IBCO=2
QUIT
+5 SET IBBEGEX=$PIECE(IBSTDT,U,2)
SET IBSTDT=$PIECE(IBSTDT,U,1)
+6 SET IBBEG=IBSTDT_"01"
+7 ;
23 ; ending month ; IB*702
+1 ;
+2 WRITE !
+3 SET IBEDDT=$$IBSM^IBCNBOA("Ending",IBSTDT)
+4 SET IBBENEX=$PIECE(IBEDDT,U,2)
SET IBEDDT=$PIECE(IBEDDT,U,1)
+5 IF 'IBEDDT
if '$$STOP^IBCNINSU
GOTO 22
SET IBCO=2
QUIT
+6 SET IBEND=$$LAST^IBAGMM(IBEDDT)
+7 SET IBCO=1
+8 QUIT
+9 ;
25 ; starting date ; IB*702
+1 ;
+2 SET IBBEG=$$DATES^IBCNBOE("Beginning")
IF 'IBBEG
if $$STOP^IBCNINSU
SET IBCO=2
QUIT
+3 ;
26 ; ending date ; IB*702
+1 ;
+2 WRITE !
+3 SET IBEND=$$DATES^IBCNBOE("Ending",IBBEG)
IF 'IBEND
if '$$STOP^IBCNINSU
GOTO 25
SET IBCO=2
QUIT
+4 SET IBCO=1
+5 QUIT
+6 ;
+7 ; IB*702/DTG end Change for up-caret response
+8 ;
RPT ; run report
+1 SET IBQUIT=0
+2 ;
+3 DO SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL)
if IBQUIT
GOTO EXIT
+4 DO PRINT(IBBEG,IBEND,IBEMPL,IBOUT)
+5 ;
EXIT KILL ^TMP($JOB),IBBA,IBBB,IBBC,IBBD,IBBEG,IBBEGEX,IBBENEX,IBBUFEM,IBBUFEME,IBBUFSD,IBBUFSM,IBBUFSMD,IBBUFSME,IBCHGDT
+1 KILL IBCO,IBCUR,IBCURFM,IBEDDT,IBEMPL,IBEND,IBHDR,IBL,IBLM,IBMONTH,IBOK,IBOUT,IBQUIT,IBSTDT,IBX
+2 if $DATA(ZTQUEUED)
QUIT
+3 DO ^%ZISC
+4 QUIT
+5 ;
SEARCH(IBBEG,IBEND,IBMONTH,IBEMPL) ; search/sort statistics for activity report
+1 NEW IBXST,IBXDT,IBBUFDA,IBB0,IBDATE,IBEMP,IBTIME,IBSTAT,IBDT2,IBVER,IBS3
SET IBQUIT=""
+2 SET IBBEG=$GET(IBBEG)-.01
SET IBEND=$SELECT('$GET(IBEND):9999999,1:$PIECE(IBEND,".")+.9)
+3 ;
+4 ; IB*702/DTG start remove verified from report
+5 ; F IBXST="A","R","V" D Q:IBQUIT
+6 FOR IBXST="A","R"
Begin DoDot:1
+7 SET IBXDT=IBBEG
FOR
SET IBXDT=$ORDER(^IBA(355.33,"AFST",IBXST,IBXDT))
if 'IBXDT!(IBXDT>IBEND)
QUIT
Begin DoDot:2
+8 SET IBBUFDA=0
FOR
SET IBBUFDA=$ORDER(^IBA(355.33,"AFST",IBXST,IBXDT,IBBUFDA))
if 'IBBUFDA
QUIT
Begin DoDot:3
+9 ;
+10 SET IBB0=$GET(^IBA(355.33,IBBUFDA,0))
+11 ;
+12 ; verified
+13 ;I IBXST="V" S IBDATE=+$P(IBB0,U,10) I +IBDATE,IBDATE>IBBEG,IBDATE<IBEND D
+14 ;. S IBEMP=+$P(IBB0,U,11) I +IBEMPL,IBEMPL'=IBEMP Q
+15 ;. S IBTIME=$$FMDIFF^XLFDT(IBDATE,+IBB0,2),IBSTAT="VERIFIED",IBS3=1
+16 ;. D SET(IBSTAT,IBEMP,$E(IBDATE,1,5),IBS3,IBTIME,IBB0,$G(IBMONTH))
+17 ; IB*702/DTG end remove verified from report
+18 ;
+19 ; processed
+20 IF IBXST="A"!(IBXST="R")
SET IBDATE=+$PIECE(IBB0,U,5)
IF +IBDATE
IF IBDATE>IBBEG
IF IBDATE<IBEND
Begin DoDot:4
+21 SET IBEMP=+$PIECE(IBB0,U,6)
IF +IBEMPL
IF IBEMPL'=IBEMP
QUIT
+22 SET IBVER=$PIECE(IBB0,U,10)
SET IBSTAT="UNKNOWN"
SET IBS3=6
+23 SET IBDT2=$SELECT(+IBVER:+IBVER,1:+IBB0)
SET IBTIME=$$FMDIFF^XLFDT(IBDATE,+IBDT2,2)
+24 ;
+25 ; IB*702/DTG start remove &V and V
+26 ;I $P(IBB0,U,4)="A" S IBS3=2,IBSTAT="ACCEPTED" I 'IBVER S IBS3=3,IBSTAT=IBSTAT_" (&V)"
+27 ;I $P(IBB0,U,4)="R" S IBS3=4,IBSTAT="REJECTED" I +IBVER S IBS3=5,IBSTAT=IBSTAT_" (V)"
+28 IF $PIECE(IBB0,U,4)="A"
SET IBS3=2
SET IBSTAT="ACCEPTED"
+29 IF $PIECE(IBB0,U,4)="R"
SET IBS3=4
SET IBSTAT="REJECTED"
+30 ; IB*702/DTG end remove &V and V
+31 DO SET(IBSTAT,IBEMP,$EXTRACT(IBDATE,1,5),IBS3,IBTIME,IBB0,$GET(IBMONTH))
End DoDot:4
End DoDot:3
End DoDot:2
SET IBQUIT=$$STOP
if IBQUIT
QUIT
End DoDot:1
if IBQUIT
QUIT
+32 ;
+33 QUIT
+34 ;
SET(STAT,IBEMP,IBDATE,S3,TIME,IBB0,IBMONTH) ;
+1 IF +$GET(IBMONTH)
DO SET1(IBSTAT,IBEMP,$EXTRACT(IBDATE,1,5),S3,IBTIME,IBB0)
+2 DO SET1(IBSTAT,IBEMP,99999,S3,IBTIME,IBB0)
+3 DO SET1(IBSTAT,"~",99999,S3,IBTIME,IBB0)
+4 QUIT
+5 ;
SET1(STAT,S1,S2,S3,TIME,IBB0) ;
+1 ;
+2 DO TMP("IBCNBOE",S1,S2,S3,TIME,STAT)
+3 DO TMP("IBCNBOE",S1,S2,9,TIME,"TOTAL")
+4 ;
+5 if $EXTRACT(STAT)'="A"
QUIT
+6 ;
+7 DO TMP1("IBCNBOEC",S1,S2,+$PIECE(IBB0,U,7),+$PIECE(IBB0,U,8),+$PIECE(IBB0,U,9))
+8 QUIT
+9 ;
TMP(XREF,S1,S2,S3,TIME,NAME) ;
+1 SET ^TMP($JOB,XREF,S1,S2,S3)=NAME
+2 SET ^TMP($JOB,XREF,S1,S2,S3,"CNT")=$GET(^TMP($JOB,XREF,S1,S2,S3,"CNT"))+1
+3 SET ^TMP($JOB,XREF,S1,S2,S3,"TM")=$GET(^TMP($JOB,XREF,S1,S2,S3,"TM"))+TIME
+4 IF '$GET(^TMP($JOB,XREF,S1,S2,S3,"HG"))!($GET(^TMP($JOB,XREF,S1,S2,S3,"HG"))<TIME)
SET ^TMP($JOB,XREF,S1,S2,S3,"HG")=TIME
+5 IF '$GET(^TMP($JOB,XREF,S1,S2,S3,"LS"))!($GET(^TMP($JOB,XREF,S1,S2,S3,"LS"))>TIME)
SET ^TMP($JOB,XREF,S1,S2,S3,"LS")=TIME
+6 ; IB*702/DTG start call set stubs for item entries.
+7 DO TMPCHK(XREF,S1,S2,S3,TIME,NAME)
+8 ; IB*702/DTG end call set stubs for item entries.
+9 QUIT
+10 ;
+11 ; IB*702/DTG start set stubs for item entries.
TMPCHK(XREF,S1,S2,S3,TIME,NAME) ; check if not there set stub for all if one is set
+1 ; use S1 (emp) and S2 (date), S3 1, 2, 4, 9
+2 NEW IBBI
+3 FOR IBBI=2,4,9
IF $GET(^TMP($JOB,XREF,S1,S2,IBBI))=""
Begin DoDot:1
+4 SET ^TMP($JOB,XREF,S1,S2,IBBI)=$PIECE(",ACCEPTED,,REJECTED,,,,,TOTAL",",",IBBI)
+5 SET ^TMP($JOB,XREF,S1,S2,IBBI,"CNT")=""
+6 SET ^TMP($JOB,XREF,S1,S2,IBBI,"TM")=""
+7 IF $GET(^TMP($JOB,XREF,S1,S2,IBBI,"HG"))=""
SET ^TMP($JOB,XREF,S1,S2,IBBI,"HG")=""
+8 IF $GET(^TMP($JOB,XREF,S1,S2,IBBI,"LS"))=""
SET ^TMP($JOB,XREF,S1,S2,IBBI,"LS")=""
End DoDot:1
+9 QUIT
+10 ; IB*702/DTG end set stubs for item entries.
+11 ;
TMP1(XREF,S1,S2,IC,GC,PC) ;
+1 IF +IC
SET ^TMP($JOB,XREF,S1,S2,"I")=$GET(^TMP($JOB,XREF,S1,S2,"I"))+1
+2 IF +GC
SET ^TMP($JOB,XREF,S1,S2,"G")=$GET(^TMP($JOB,XREF,S1,S2,"G"))+1
+3 IF +PC
SET ^TMP($JOB,XREF,S1,S2,"P")=$GET(^TMP($JOB,XREF,S1,S2,"P"))+1
+4 SET ^TMP($JOB,XREF,S1,S2,"CNT")=$GET(^TMP($JOB,XREF,S1,S2,"CNT"))+1
+5 QUIT
+6 ;
+7 ;
+8 ;
PRINT(IBBEG,IBEND,IBEMPL,IBOUT) ;
+1 NEW IBXREF,IBLABLE,IBEMPN,IBS1,IBS2,IBS3,IBINS,IBGRP,IBPOL,IBCNT,IBIP,IBGP,IBPP,IBRDT,IBPGN,IBRANGE,IBLN,IBI
+2 ;
+3 ; IB*702/DTG start stop push of line on screen up
+4 NEW MAXCNT,CRT
+5 SET MAXCNT=IOSL-8
+6 ; IB*702/DTG end stop push of line on screen up
+7 IF "^R^E^"'[(U_$GET(IBOUT)_U)
SET IBOUT="R"
+8 SET IBRANGE=$$FMTE^XLFDT(IBBEG)_" - "_$$FMTE^XLFDT(IBEND)
+9 SET IBRDT=$$FMTE^XLFDT($JUSTIFY($$NOW^XLFDT,0,4),2)
SET IBRDT=$TRANSLATE(IBRDT,"@"," ")
SET (IBLN,IBPGN)=0
+10 ; IB*702/DTG start Combine vars, no data check, end of report
+11 SET IBXREF="IBCNBOE"
SET IBS1=""
+12 ;
+13 if IBOUT="R"
DO HDR
if IBOUT="E"
DO PHDL
+14 IF '$DATA(^TMP($JOB,IBXREF))
Begin DoDot:1
+15 WRITE !
if $GET(IBOUT)="R"
WRITE ?((IOM\2)-17)
WRITE "* * * N O D A T A F O U N D * * *",!
+16 DO EOR^IBCNBOF(IOM)
+17 SET IBI=$$PAUSE
End DoDot:1
QUIT
+18 ;
+19 ;
+20 ; Excel output
+21 IF IBOUT="E"
Begin DoDot:1
+22 ;S IBXREF="IBCNBOE",IBS1="" F S IBS1=$O(^TMP($J,IBXREF,IBS1)) Q:IBS1="" D
+23 FOR
SET IBS1=$ORDER(^TMP($JOB,IBXREF,IBS1))
if IBS1=""
DO EOR(132)
if IBS1=""
QUIT
Begin DoDot:2
+24 SET IBS2=0
FOR
SET IBS2=$ORDER(^TMP($JOB,IBXREF,IBS1,IBS2))
if IBS2=""
QUIT
Begin DoDot:3
+25 DO GETLABL
+26 SET IBS3=""
FOR
SET IBS3=$ORDER(^TMP($JOB,IBXREF,IBS1,IBS2,IBS3))
if 'IBS3
QUIT
DO PRTLN
+27 ;
+28 DO GETOAC
+29 WRITE U_IBINS_U_IBIP_"%"_U_IBGRP_U_IBGP_"%"_U_IBPOL_U_IBPP_"%"
End DoDot:3
End DoDot:2
End DoDot:1
SET IBI=$$PAUSE
QUIT
+30 ;
+31 ; Report Section
+32 ;D HDR
+33 ;
+34 ;S IBXREF="IBCNBOE",IBS1="" F S IBS1=$O(^TMP($J,IBXREF,IBS1)) Q:IBS1="" D Q:IBQUIT
+35 FOR
SET IBS1=$ORDER(^TMP($JOB,IBXREF,IBS1))
if IBS1=""
DO EOR(80)
if IBS1=""
QUIT
Begin DoDot:1
+36 ;
+37 ;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
+38 ; IB*702/DTG
SET IBS2=0
FOR
SET IBS2=$ORDER(^TMP($JOB,IBXREF,IBS1,IBS2))
if IBS2=""
QUIT
if IBLN+8>MAXCNT
DO HDR
if IBQUIT
QUIT
Begin DoDot:2
+39 DO GETLABL
+40 WRITE !,?(40-($LENGTH(IBLABLE)/2)),IBLABLE,!
+41 WRITE !,?43,"AVERAGE",?56,"LONGEST",?68,"SHORTEST"
+42 WRITE !,"STATUS",?22,"COUNT",?30,"PERCENT",?43,"# DAYS",?56,"# DAYS",?68,"# DAYS"
+43 WRITE !,"-----------------------------------------------------------------------------"
+44 ;
+45 SET IBS3=""
FOR
SET IBS3=$ORDER(^TMP($JOB,IBXREF,IBS1,IBS2,IBS3))
if 'IBS3
QUIT
DO PRTLN
SET IBLN=IBLN+1
+46 ;
+47 DO GETOAC
+48 WRITE !!,?2,IBINS," New Compan",$SELECT(IBINS=1:"y",1:"ies")," (",IBIP,"%), "
+49 WRITE IBGRP," New Group/Plan",$SELECT(IBGRP=1:"",1:"s")," (",IBGP,"%), "
+50 WRITE IBPOL," New Patient Polic",$SELECT(IBPOL=1:"y",1:"ies")," (",IBPP,"%)",!
End DoDot:2
SET IBLN=IBLN+8
End DoDot:1
if IBQUIT
QUIT
+51 ;
+52 IF 'IBQUIT
SET IBI=$$PAUSE
+53 QUIT
+54 ;
+55 ; IB*702/DTG start Combine parts for excel and report
+56 ;
GETLABL ; pick up common values for Excel and Report
+1 ;
+2 SET IBLABLE=$SELECT(IBS2=99999:"TOTALS",($EXTRACT(IBBEG,1,5)<IBS2)&($EXTRACT(IBEND,1,5)>IBS2):$$FMTE^XLFDT(IBS2_"00"),1:"")
+3 ;<
IF IBLABLE=""
Begin DoDot:1
+4 SET IBLABLE=$$FMTE^XLFDT($SELECT($EXTRACT(IBBEG,1,5)<IBS2:IBS2_"01",1:IBBEG))_" - "_$$FMTE^XLFDT($SELECT($EXTRACT(IBEND,1,5)>IBS2:$$SCH^XLFDT("1M(L)",IBS2_11),1:IBEND))
+5 IF $GET(IBMONTH)&(IBLABLE["-")
SET IBLABLE=$$FMTE^XLFDT(IBS2_"00")
End DoDot:1
+6 SET IBEMPN=$PIECE($GET(^VA(200,IBS1,0)),U,1)
+7 IF IBOUT="R"
SET IBLABLE=IBEMPN_" "_IBLABLE
+8 QUIT
+9 ;
GETOAC ; pick up items for IBCNBOEC
+1 ;
+2 SET IBINS=+$GET(^TMP($JOB,"IBCNBOEC",IBS1,IBS2,"I"))
SET IBGRP=+$GET(^TMP($JOB,"IBCNBOEC",IBS1,IBS2,"G"))
+3 SET IBPOL=+$GET(^TMP($JOB,"IBCNBOEC",IBS1,IBS2,"P"))
SET IBCNT=+$GET(^TMP($JOB,"IBCNBOEC",IBS1,IBS2,"CNT"))
+4 SET (IBIP,IBGP,IBPP)=0
IF IBCNT'=0
SET IBIP=((IBINS/IBCNT)*100)\1
SET IBGP=((IBGRP/IBCNT)*100)\1
SET IBPP=((IBPOL/IBCNT)*100)\1
+5 QUIT
+6 ;
EOR(IBLE) ; write end of report
+1 IF '$GET(IBLE)
SET IBLE=80
+2 IF IBLN>MAXCNT
DO HDR
if IBQUIT
QUIT
+3 WRITE !
if $GET(IBOUT)="R"
WRITE ?((IBLE\2)-10)
WRITE "*** END OF REPORT ***"
+4 QUIT
+5 ;
+6 ; IB*702/DTG end Combine parts for excel and report
+7 ;
PRTLN ; IB*702 Rewrote tag to print zeros for statuses with no counts
+1 NEW IBSTX,IBCNT,IBTM,IBHG,IBLS,IBTCNT
+2 ;
+3 NEW IBBA,IBBB,IBBC
+4 ;
+5 SET IBSTX=$GET(^TMP($JOB,IBXREF,IBS1,IBS2,IBS3))
+6 ;S IBCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,IBS3,"CNT")) Q:'IBCNT ;IB*702 removed quit
+7 SET IBCNT=$GET(^TMP($JOB,IBXREF,IBS1,IBS2,IBS3,"CNT"))
+8 SET IBTM=$GET(^TMP($JOB,IBXREF,IBS1,IBS2,IBS3,"TM"))
+9 SET IBHG=$GET(^TMP($JOB,IBXREF,IBS1,IBS2,IBS3,"HG"))
+10 SET IBLS=$GET(^TMP($JOB,IBXREF,IBS1,IBS2,IBS3,"LS"))
+11 ;S IBTCNT=$G(^TMP($J,IBXREF,IBS1,IBS2,9,"CNT")) Q:'IBTCNT ;IB*702 removed quit
+12 SET IBTCNT=$GET(^TMP($JOB,IBXREF,IBS1,IBS2,9,"CNT"))
+13 ;
+14 ; Excel output
+15 IF IBOUT="E"
Begin DoDot:1
+16 WRITE !,IBEMPN_U_IBLABLE_U_IBSTX_U_$FNUMBER(IBCNT,",")_U
+17 SET IBBA=$SELECT((IBCNT'=""&(IBTCNT'="")):((IBCNT/IBTCNT)*100),1:0)
SET IBBC=$$EXN^IBCNBOF(IBBA)
WRITE IBBC_"%"_U
+18 SET IBBA=$SELECT(IBCNT'="":$$STD((IBTM/IBCNT)),1:0)
SET IBBC=$$EXN^IBCNBOF(IBBA)
WRITE IBBC_U
+19 SET IBBA=$$STD(IBHG)
SET IBBC=$$EXN^IBCNBOF(IBBA)
WRITE IBBC_U
+20 SET IBBA=$$STD(IBLS)
SET IBBC=$$EXN^IBCNBOF(IBBA)
WRITE IBBC
End DoDot:1
QUIT
+21 ;
+22 ; Report output
+23 WRITE !,IBSTX,?20,$JUSTIFY($FNUMBER(IBCNT,","),7)
+24 SET IBBA=$SELECT((IBCNT'=""&(IBTCNT'="")):((IBCNT/IBTCNT)*100),1:0)
WRITE ?30,$JUSTIFY(IBBA,6,1),"%"
+25 SET IBBA=$SELECT(IBCNT'="":$$STD((IBTM/IBCNT)),1:0)
WRITE ?43,$JUSTIFY(IBBA,6,1)
+26 WRITE ?56,$JUSTIFY($$STD(IBHG),6,1),?68,$JUSTIFY($$STD(IBLS),6,1)
+27 QUIT
+28 ;
STD(SEC) ; convert seconds to days
+1 NEW IBX,IBD,IBS,IBH,DAYS
SET DAYS=""
if '$GET(SEC)
GOTO STDQ
+2 SET IBD=(SEC/86400)
SET IBD=+$PIECE(IBD,".")
+3 SET IBS=SEC-(IBD*86400)
+4 SET IBH=((IBS/60)/60)
SET IBH=+$JUSTIFY(IBH,0,2)
+5 SET DAYS=IBD+(IBH/24)
STDQ QUIT DAYS
+1 ;
HDR ;print the report header
+1 SET IBQUIT=$$STOP
if IBQUIT
QUIT
+2 IF IBPGN>0
SET IBQUIT=$$PAUSE
if IBQUIT
QUIT
+3 SET IBPGN=IBPGN+1
SET IBLN=5
IF IBPGN>1!($EXTRACT(IOST,1,2)["C-")
WRITE @IOF
+4 ; IB*702/DTG start change INSURANCE to INS
+5 ;W !,"INSURANCE BUFFER EMPLOYEE REPORT ",IBRANGE," "
+6 WRITE !,"INS BUFFER EMPLOYEE REPORT ",IBRANGE," "
+7 ;W ?(IOM-22),IBRDT,?(IOM-7)," PAGE ",IBPGN,!
+8 WRITE ?(IOM-23),IBRDT,?(IOM-8),"PAGE ",IBPGN,!
+9 IF +$GET(IBEMPL)
WRITE !,"EMPLOYEE: ",$PIECE($GET(^VA(200,+IBEMPL,0)),U,1),!
+10 SET IBI=""
SET $PIECE(IBI,"-",IOM+1)=""
WRITE IBI,!
+11 QUIT
+12 ;
PHDL ; - Print the header line for the Excel spreadsheet
+1 NEW X
+2 ; IB*602/HN ; Add report headers to Excel Spreadsheets
+3 ;W !,"INSURANCE BUFFER EMPLOYEE REPORT^"_IBRANGE_"^"_$$FMTE^XLFDT($$NOW^XLFDT,1),!
+4 WRITE !,"INS BUFFER EMPLOYEE REPORT^"_IBRANGE_"^"_$$FMTE^XLFDT($$NOW^XLFDT,1),!
+5 IF +$GET(IBEMPL)
WRITE "EMPLOYEE: ",$PIECE($GET(^VA(200,+IBEMPL,0)),U,1),!
+6 ; IB*602/HN end
+7 SET X="EMPLOYEE^MONTH^STATUS^COUNT^PERCENT^AVERAGE # DAYS^LONGEST # DAYS^SHORTEST # DAYS^New Companies^"
+8 SET X=X_"% New Companies^New Group/Plans^% New Group/Plans^New Patient Policies^% New Patient Policies"
+9 WRITE X
+10 KILL X
+11 QUIT
+12 ; IB*702/DTG end change INSURANCE to INS
+13 ;
PAUSE() ;pause at end of screen if beeing displayed on a terminal
+1 NEW IBX,DIR,DIRUT,X,Y
SET IBX=0
+2 IF $EXTRACT(IOST,1,2)["C-"
WRITE !!
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DIRUT))
SET IBX=1
+3 QUIT IBX
+4 ;
STOP() ;determine if user has requested the queued report to stop
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
IF +$GET(IBPGN)
WRITE !,"***TASK STOPPED BY USER***"
+2 QUIT +$GET(ZTSTOP)
+3 ;
WR() ; which report
+1 ; IB*702/DTG start remove verified from report
+2 NEW DIR,X,Y,DIRUT,DUOUT,IBX
SET IBX=""
+3 ;S DIR("?")="Enter 'V' for a report based on employees that verify or process (accept/reject) buffer entries."
+4 SET DIR("?")="Enter 'P' for a report based on employees that process (accept/reject) buffer entries."
+5 SET DIR("?",5)="Enter 'E' for a report based on employees that create new buffer entries."
+6 SET DIR("?",1)="This report may be printed for those employees that create Buffer entries,"
+7 ;S DIR("?",2)="primarily non-Insurance personnel or for those employees that verify and process"
+8 SET DIR("?",2)="primarily non-Insurance personnel or for those employees that process"
+9 SET DIR("?",3)="(accept/reject) Buffer entries, primarily Insurance Personnel."
+10 SET DIR("?",4)=" "
+11 ;S DIR("A")="Include which Type of Employee",DIR(0)="SO^1:Entered By;2:Verified/Processed By" D ^DIR
+12 SET DIR("A")="Include which Type of Employee"
SET DIR(0)="SO^1:Entered By;2:Processed By"
+13 DO ^DIR
+14 SET IBX=$SELECT(Y>0:+Y,1:"")
+15 QUIT IBX
+16 ; IB*702/DTG end remove verified from report
+17 ;
EMPL() ; print a single or all employees?
+1 NEW DIR,X,Y,DIRUT,DUOUT,IBX
SET IBX=""
+2 SET DIR("?",1)="Report of activity in the Buffer file by Employee and date range."
+3 SET DIR("?",2)="Enter 'S' to include only a single employee in the report."
+4 SET DIR("?")="Enter 'A' to include all employees in the report."
+5 SET DIR("A")="Include Selected or All Employees"
+6 SET DIR("B")="All"
SET DIR(0)="SO^A:All Employees;S:Selected Employee"
DO ^DIR
+7 SET IBX=$SELECT(Y="S":1,Y="A":0,1:"")
+8 QUIT IBX
+9 ;
SELEMPL(TYPE) ; get the name of an employee
+1 NEW DIC,X,Y,DTOUT,DUOUT,IBX
SET IBX=""
+2 SET DIC("A")="Select an Employee that "_TYPE_" Buffer entries: "
+3 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
SET IBX=+Y
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<1)
SET IBX=""
+4 QUIT IBX
+5 ;
DATES(LABLE,IBBEG) ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,IBX,IBB,IBD,IBE,X,Y
+2 ; IB*702/DTG start update date prompt & "?" text
+3 SET IBBEG=$GET(IBBEG)
+4 SET IBX=""
SET IBB=$PIECE($SELECT(+$GET(IBBEG):IBBEG,1:+$ORDER(^IBA(355.33,"B",0))),".")
SET IBD=$SELECT(+$GET(IBBEG):DT,1:IBB)
+5 IF IBBEG'=""
SET IBE="Beginning Date ("_$$FMTE^XLFDT(IBBEG)_")"
+6 IF IBBEG=""
WRITE !!
SET IBE="date of the first Buffer entry ("_$$FMTE^XLFDT(IBB)_")"
DATES1 ;Repeat for ending date outside of range
+1 SET DIR("?")="Enter the "_LABLE_" date to include in the report."
+2 SET DIR("?",1)="Enter a date from the "_IBE_" to today."
+3 SET DIR("A")=LABLE_" Date"
+4 SET DIR(0)="DO^::EX"
DO ^DIR
+5 SET IBX=Y
+6 IF Y=""
WRITE *7,!,"Enter the "_LABLE_" Date or '^' to Quit.",!
GOTO DATES1
+7 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET IBX=""
+8 IF 'IBX
GOTO DATESX
+9 IF (IBX<IBB)
WRITE *7,!,"Date cannot be less than the "_IBE_".",!
GOTO DATES1
+10 IF (IBX>DT)
WRITE *7,!,"Date cannot be greater than Today.",!
GOTO DATES1
+11 ;
DATESX ;Exit Dates setup
+1 QUIT IBX
+2 ;
MONTH() ;
+1 NEW DIR,X,Y,DIRUT,DUOUT,IBX
SET IBX=""
+2 ; IB*702/DTG start update month prompt & "?" text
+3 SET DIR("?")="include the current month. Enter '^' to quit"
+4 SET DIR("?",1)="Answer YES if you'd like to see totals for previous months."
+5 SET DIR("?",2)="Answer NO if you'd like to see data on a selected date range which may"
+6 SET DIR("A")="Report Previous Completed Month(s)"
SET DIR(0)="Y"
SET DIR("B")="No"
DO ^DIR
+7 ; IB*702/DTG end update month prompt & "?" text
+8 SET IBX=$SELECT(Y=1:Y,Y=0:Y,1:"")
+9 QUIT IBX
+10 ;
OUT() ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
IF $DATA(DIRUT)
QUIT ""
+7 QUIT Y
