TIURVBC ;ISL/JER - Visible Black Character Line Count Report ;05/20/10 12:43
;;1.0;TEXT INTEGRATION UTILITIES;**250**;Jun 20, 1997;Build 14
;
; ICR #2055 - $$EXTERNAL^DILFD
; #2056 - $$GET1^DIQ
; #3799 - $$FMTE^XLFDT
; #4558 - $$LEAP^XLFDT3
; #4631 - $$NOW^XLFDT
; #10000 - %, %I, %T, %Y Local vars
; #10063 - ^%ZTLOAD
; #10086 - ^%ZIS Routine & IO, IOF, ION, IOSL, & IOST Local Vars
; #10089 - ^%ZISC Routine & IO("Q") Local Var
; #10104 - $$LOW^XLFSTR, $$UP^XLFSTR
; #10112 - $$NAME^VASITE, $$SITE^VASITE
; #10114 - %ZIS Local Var
;
MAIN ; Main subroutine
N DIC,DIRUT,BADDIV,SELDIV,TIUEDT,TIULDT,TIUDI,VAUTD,ZTRTN,%I,%T,%Y,POP,TIU1TR,TIUTR,TIUSONLY
S TIUTR=0
W !!,$$CENTER^TIULS("--- Transcription Billing Verification Report ---"),!
D SELDIV^TIULA Q:SELDIV=-1
I +SELDIV=0 D Q:'$D(TIUDI)
. W !!,"Inconsistencies found between the MEDICAL CENTER DIVISION FILE, the INSTITUTION"
. W !,"FILE and/or STATION NUMBER (TIME SENSITIVE) FILE for the:",!!,$S($G(BADDIV)]"":BADDIV_" division"_$S($L(BADDIV,",")>1:"s",1:""),1:"a division you selected"),"."
. W !!,"Please contact the National Support team."
. I '$D(TIUDI) W ! S:'$$READ^TIUU("E") DIRUT=1
I $D(TIUDI) D
. N TIUK
. S TIUK=0 F S TIUK=$O(TIUDI(TIUK)) Q:'TIUK D
. . S TIUDI("INST",TIUDI(TIUK))=TIUK
. . S TIUDI("ENTRIES")=$G(TIUDI("ENTRIES"))_TIUK_";"
E S TIUDI("ENTRIES")="ALL DIVISIONS"
W !
S TIU1TR=$$READ^TIUU("YA","Specific Transcriptionist(s)? ","NO","Indicate whether you would like to run the report for one or more specific Transcriptionists.")
I $D(DIRUT) Q
I +TIU1TR D TRNSEL(.TIUTR) Q:'+$G(TIUTR)!+$G(DIROUT)
W !
S TIUSONLY=$$READ^TIUU("YA","Print Summary Page Only? ","NO","Indicate whether you would like to see only the Summary Page (i.e., no Details).")
I $D(DIRUT) Q
W !
S TIUEDT=+$$EDATE^TIULA("Transcription","",$$DFLTDT("E"))
W !
I TIUEDT'>0 Q
S TIULDT=+$$LDATE^TIULA("Transcription","",$$DFLTDT("L"))
W !
I TIULDT'>0 Q
S ZTRTN="ENTRY^TIURVBC"
DEVICE ; Device handling
; Call with: ZTRTN
N %ZIS
S %ZIS="Q" D ^%ZIS Q:POP
G:$D(IO("Q")) QUE
NOQUE ; Call report directly
D @ZTRTN
Q
QUE ; Queue output
N %,ZTDTH,ZTIO,ZTSAVE,ZTSK
Q:'$D(ZTRTN)
K IO("Q") F %="DA","DFN","TIU*" S ZTSAVE(%)=""
S:'$D(ZTDESC) ZTDESC="PRINT TRANSCRIPTION BILLING REPORT" S ZTIO=ION
D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
D HOME^%ZIS
Q
TRNSEL(TIUY) ; Select Transcriptionists
N DIRUT,TIUQUIT,TIUPRSN,TIUI,TIUPRMT,TIUVBCUC,TIUSCRN,TIUHLP S (TIUY,TIUI,TIUQUIT)=0
; Identify User Class for VBC Line Count
S TIUVBCUC=$$GET^XPAR("DIV.`"_DUZ(2)_"^SYS","TIU USER CLASS FOR VBC")
S TIUHLP="Please choose a "_$S(+TIUVBCUC:"KNOWN ",1:"")_"Transcriptionist (Duplicates not allowed)."
S TIUSCRN="I '$D(TIUY(""I"",+Y))"_$S(+TIUVBCUC:",$$ISA^USRLM(+Y,TIUVBCUC)",1:"")
W !!,"Select Transcriptionist(s):",!
F D Q:+TIUQUIT
. S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") "
. S TIUPRSN=$$READ^TIUU("PAO^200:AEMQ",TIUPRMT,"",TIUHLP,TIUSCRN)
. I +TIUPRSN'>0 S TIUQUIT=1 Q
. S TIUY=TIUI,TIUY(TIUI)=TIUPRSN,TIUY("I",+TIUPRSN)=TIUI
W !
Q
ENTRY ; Build & Print Report
N TIUA
S TIUA=$NA(^TMP("TIURVBC",$J)) K @TIUA
U IO
D GATHER(.TIUDI,TIUA,TIUEDT,TIULDT,.TIUTR)
D REPORT(TIUA,TIUEDT,TIULDT,TIUSONLY)
K @TIUA
D ^%ZISC
Q
DFLTDT(EORL) ; Compute default early or late date
N DOM,MON,YR,FMDT,DFLTDT
S YR=$E(DT,1,3),MON=$E(DT,4,5),DOM=$E(DT,6,7)
I DOM<15 D I 1
. I +MON=1 S MON=12,YR=YR-1
. E S MON=MON-1 S:$L(MON)=1 MON="0"_MON
. S DOM=$S(EORL="E":"01",1:$$LDOM(MON,YR))
. S FMDT=YR_MON_DOM_$S(EORL="L":".2359",1:"")
E D
. I EORL="E" S DOM="01",FMDT=YR_MON_DOM
. E S DFLTDT="NOW"
I $G(DFLTDT)'="NOW" S DFLTDT=$$FMTE^XLFDT(FMDT)
Q DFLTDT
LDOM(MON,YR) ; Calculate last day of month MON
N LEAP,LDOMS S YR=1700+YR,LEAP=$$LEAP^XLFDT3(YR)
S LDOMS="31^"_(LEAP+28)_"^31^30^31^30^31^31^30^31^30^31"
Q $P(LDOMS,U,MON)
GATHER(TIUDI,TIUA,TIUEDT,TIULDT,TIUTR) ; Gather records that satisfy criteria
N TIUTDT,TIUVBCUC
; Insure inclusive early date/time by subtracting one minute before $ORDER
S TIUTDT=$$FMADD^XLFDT(TIUEDT,0,0,-1)
; Insure inclusive end date/time by appending time of 23:59 if time not indicated
I $L(TIULDT,".")=1 S $P(TIULDT,".",2)="2359"
F S TIUTDT=$O(^TIU(8925,"VBC",TIUTDT)) Q:+TIUTDT'>0!(+TIUTDT>TIULDT) D
. N TIUVBC S TIUVBC=0
. F S TIUVBC=$O(^TIU(8925,"VBC",TIUTDT,TIUVBC)) Q:+TIUVBC'>0 D
. . N TIUDA S TIUDA=0
. . F S TIUDA=$O(^TIU(8925,"VBC",TIUTDT,TIUVBC,TIUDA)) Q:+TIUDA'>0 D
. . . N TIUAUTH,TIUD0,TIUD12,TIUD13,TIUD14,TIUDIV,TIUEBY,TIUPTNM,TIUTITLE,TIUSVC,TIUPTL4
. . . S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)),TIUD14=$G(^(14))
. . . S TIUAUTH=$P(TIUD12,U,2),TIUDIV=$P(TIUD12,U,12),TIUEBY=$P(TIUD13,U,2)
. . . S TIUSVC=$P(TIUD14,U,4)
. . . I TIUAUTH=TIUEBY Q
. . . I +$G(TIUTR),'$D(TIUTR("I",+TIUEBY)) Q
. . . I $S(TIUDI("ENTRIES")="ALL DIVISIONS":0,$D(TIUDI("INST",+TIUDIV)):0,1:1) Q
. . . ; Identify User Class for VBC Line Count
. . . S TIUVBCUC=$$GET^XPAR($S(TIUDIV]"":"DIV.`"_TIUDIV_"^",1:"")_"SYS","TIU USER CLASS FOR VBC")
. . . ; If User Class defined & document not entered by a member, quit to next document
. . . I TIUVBCUC]"",'+$$ISA^USRLM(TIUEBY,TIUVBCUC) Q
. . . S TIUSVC=$S(TIUSVC]"":$E($$EXTERNAL^DILFD(8925,1404,"",TIUSVC),1,8),1:"UNKNOWN")
. . . S TIUDIV=$S(TIUDIV]"":$$EXTERNAL^DILFD(8925,1212,"",TIUDIV),1:"DIVISION UNKNOWN")
. . . S TIUEBY=$S(TIUEBY]"":$$LOW^XLFSTR($$INITIALS(TIUEBY)),1:"n/a")
. . . S TIUTITLE=$E($$PNAME^TIULC1($P(TIUD0,U)),1,23)
. . . S TIUAUTH=$S(TIUAUTH]"":$$UP^XLFSTR($$INITIALS(TIUAUTH)),1:"N/A")
. . . S TIUPTL4=$E($$GET1^DIQ(2,$P(TIUD0,U,2),.09),6,9) S:TIUPTL4']"" TIUPTL4="UNKN"
. . . S TIUPTNM=$E($$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FIRST MI"),1,19)_"|"_TIUPTL4
. . . S @TIUA@(TIUDIV,TIUEBY,TIUTDT,TIUDA)=TIUTITLE_U_TIUPTNM_U_TIUAUTH_U_TIUVBC_U_TIUSVC
Q
INITIALS(TIUX) ; Get Person's initials from file 200
N TIUY S TIUY=$$GET1^DIQ(200,TIUX,1)
Q $S($L(TIUY):TIUY,1:$$NAME^TIULS($$PERSNAME^TIULC1(TIUX),"FIMILI"))
REPORT(TIUA,TIUEDT,TIULDT,TIUSONLY) ; Generate report
N TIUDIV,TIUDVBC,TIUDCNT,TIUSVBC,TIUSCNT,TIURTM,DIRUT,DTOUT,TIUSITE,TIUCAT,TIUI,TIUPG
N TIUSHDR,EQLN S $P(EQLN,"-",11)="",TIUPG=0,TIUSONLY=+$G(TIUSONLY)
I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
U IO
S TIURTM=$$NOW^XLFDT,TIUSITE=$S($$NAME^VASITE]"":$$NAME^VASITE,1:$P($$SITE^VASITE,U,2))
I '$D(@TIUA) D Q
. D HEADER("",TIURTM,TIUEDT,TIULDT,.TIUPG)
. W:$$CONTINUE("",TIURTM,TIUEDT,TIULDT,.TIUPG) !
. W:$$CONTINUE("",TIURTM,TIUEDT,TIULDT,.TIUPG) "No Documents Transcribed for selected Division(s) & Date Range...",!
. I ($E(IOST)="C"),($E(IOSL,1,3)'=999) S:'+$$STOP^TIUU("",1) DIRUT=1
S (TIUDIV,TIUSVBC,TIUSCNT)=0
F S TIUDIV=$O(@TIUA@(TIUDIV)) Q:TIUDIV']"" D Q:$D(DIRUT)
. N TIUDTVBC,TIUEBY,TIUEBVBC,TIUEBCNT S TIUEBY="",(TIUDVBC,TIUDCNT)=0
. D:'TIUSONLY HEADER(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
. F S TIUEBY=$O(@TIUA@(TIUDIV,TIUEBY)) Q:TIUEBY']"" D Q:$D(DIRUT)
. . N TIUTDT S (TIUDTVBC,TIUTDT)=0
. . S TIUEBCNT=+$P($G(@TIUA@(0,"EBY",TIUEBY)),U)
. . S TIUEBVBC=+$P($G(@TIUA@(0,"EBY",TIUEBY)),U,2)
. . W:'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG) TIUEBY
. . F S TIUTDT=$O(@TIUA@(TIUDIV,TIUEBY,TIUTDT)) Q:TIUTDT'>0 D Q:$D(DIRUT)
. . . N TIUDA S TIUDA=0
. . . F S TIUDA=$O(@TIUA@(TIUDIV,TIUEBY,TIUTDT,TIUDA)) Q:TIUDA'>0 D Q:$D(DIRUT)
. . . . N TIUD,TIUTITLE,TIUPTNM,TIUAUTH,TIUVBC,TIUSVC
. . . . S TIUD=$G(@TIUA@(TIUDIV,TIUEBY,TIUTDT,TIUDA))
. . . . S TIUTITLE=$P(TIUD,U),TIUPTNM=$P(TIUD,U,2),TIUAUTH=$P(TIUD,U,3),TIUVBC=$P(TIUD,U,4),TIUSVC=$P(TIUD,U,5)
. . . . S TIUDVBC=TIUDVBC+TIUVBC,TIUDCNT=TIUDCNT+1,@TIUA@(0,"Division",TIUDIV)=TIUDCNT_U_TIUDVBC
. . . . S TIUEBVBC=TIUEBVBC+TIUVBC,TIUEBCNT=TIUEBCNT+1,@TIUA@(0,"EBY",TIUEBY)=TIUEBCNT_U_TIUEBVBC
. . . . S TIUSVBC=TIUSVBC+TIUVBC,TIUSCNT=TIUSCNT+1,@TIUA@(0,"Station",TIUSITE)=TIUSCNT_U_TIUSVBC
. . . . S TIUDTVBC=TIUDTVBC+TIUVBC ; Transcriber total for this division
. . . . W:'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG) ?5,$$DATE^TIULS(TIUTDT,"MM/DD/YY"),?14,TIUTITLE,?39,$P(TIUPTNM,"|"),?59,"(",$P(TIUPTNM,"|",2),")",?66,TIUAUTH,?70,$J(TIUVBC,10,2),!
. . Q:$D(DIRUT)
. . W:'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG) ?70,EQLN,!
. . W:'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG) ?42,"Total for Transcriber ",$J(TIUEBY,3)," = ",?70,$J(TIUDTVBC,10,2),!
. . W:'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG) !
. Q:$D(DIRUT)
. W:'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG) ?70,EQLN,!
. W:'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG) ?49,"Total for Division = ",?70,$J(TIUDVBC,10,2),!
. I 'TIUSONLY,($E(IOST)="C"),($E(IOSL,1,3)'=999) S:'+$$STOP^TIUU("",1) DIRUT=1
I $D(DIRUT)!'$D(@TIUA@(0)) Q
;Summarize
S TIUCAT="",TIUSHDR="SUMMARY for "_TIUSITE
D HEADER(TIUSHDR,TIURTM,TIUEDT,TIULDT,.TIUPG)
F S TIUCAT=$O(@TIUA@(0,TIUCAT)) Q:TIUCAT']"" D Q:$D(DIRUT)
. W:$$CONTINUE(TIUSHDR,TIURTM,TIUEDT,TIULDT,.TIUPG) !,$S(TIUCAT="EBY":"Transcriber",1:TIUCAT)," Totals",!
. S TIUI="" F S TIUI=$O(@TIUA@(0,TIUCAT,TIUI)) Q:TIUI']"" D
. . N TIUR S TIUR=@TIUA@(0,TIUCAT,TIUI)
. . W:$$CONTINUE(TIUSHDR,TIURTM,TIUEDT,TIULDT,.TIUPG) ?2,TIUI,?48,$P(TIUR,U),?70,$J($P(TIUR,U,2),10,2),!
I ($E(IOST)="C"),($E(IOSL,1,3)'=999) S:'+$$STOP^TIUU("",1) DIRUT=1
Q
CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,TIUPG) ; Evaluate relative page position
N TIUY S TIUY=1
I $Y'>(IOSL-3) G CONTX
I $E(IOST)="C" S TIUY=+$$READ^TIUU("E") I $D(DIRUT)!(TIUY'>0) G CONTX
D HEADER(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
CONTX Q TIUY
N TIULINE,TIUDTR S $P(TIULINE,"=",81)="",TIUDTR=$$DATE^TIULS(TIUEDT,"MM/DD/CCYY")_" to "_$$DATE^TIULS(TIULDT,"MM/DD/CCYY")
S TIUPG=TIUPG+1
W @IOF D JUSTIFY^TIUU("Page "_TIUPG,"R") W !
W TIULINE,! D JUSTIFY^TIUU($$TITLE^TIUU("TRANSCRIPTION BILLING REPORT"),"C") W !
D JUSTIFY^TIUU(DIVISION,"C")
W !
W "for Documents Transcribed: ",TIUDTR,?55,"Printed: ",$$DATE^TIULS(TIURTM,"MM/DD/CCYY HR:MIN"),!
W !
I DIVISION'["SUMMARY" W "Tran",?5,"Date",?14,"Title",?39,"Patient",?66,"Aut",?71,"VBC Lines",!
W TIULINE,!
E W "Category",?48,"Documents",?71,"VBC Lines",!,TIULINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURVBC 10528 printed Dec 13, 2024@02:45:38 Page 2
TIURVBC ;ISL/JER - Visible Black Character Line Count Report ;05/20/10 12:43
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**250**;Jun 20, 1997;Build 14
+2 ;
+3 ; ICR #2055 - $$EXTERNAL^DILFD
+4 ; #2056 - $$GET1^DIQ
+5 ; #3799 - $$FMTE^XLFDT
+6 ; #4558 - $$LEAP^XLFDT3
+7 ; #4631 - $$NOW^XLFDT
+8 ; #10000 - %, %I, %T, %Y Local vars
+9 ; #10063 - ^%ZTLOAD
+10 ; #10086 - ^%ZIS Routine & IO, IOF, ION, IOSL, & IOST Local Vars
+11 ; #10089 - ^%ZISC Routine & IO("Q") Local Var
+12 ; #10104 - $$LOW^XLFSTR, $$UP^XLFSTR
+13 ; #10112 - $$NAME^VASITE, $$SITE^VASITE
+14 ; #10114 - %ZIS Local Var
+15 ;
MAIN ; Main subroutine
+1 NEW DIC,DIRUT,BADDIV,SELDIV,TIUEDT,TIULDT,TIUDI,VAUTD,ZTRTN,%I,%T,%Y,POP,TIU1TR,TIUTR,TIUSONLY
+2 SET TIUTR=0
+3 WRITE !!,$$CENTER^TIULS("--- Transcription Billing Verification Report ---"),!
+4 DO SELDIV^TIULA
if SELDIV=-1
QUIT
+5 IF +SELDIV=0
Begin DoDot:1
+6 WRITE !!,"Inconsistencies found between the MEDICAL CENTER DIVISION FILE, the INSTITUTION"
+7 WRITE !,"FILE and/or STATION NUMBER (TIME SENSITIVE) FILE for the:",!!,$SELECT($GET(BADDIV)]"":BADDIV_" division"_$SELECT($LENGTH(BADDIV,",")>1:"s",1:""),1:"a division you selected"),"."
+8 WRITE !!,"Please contact the National Support team."
+9 IF '$DATA(TIUDI)
WRITE !
if '$$READ^TIUU("E")
SET DIRUT=1
End DoDot:1
if '$DATA(TIUDI)
QUIT
+10 IF $DATA(TIUDI)
Begin DoDot:1
+11 NEW TIUK
+12 SET TIUK=0
FOR
SET TIUK=$ORDER(TIUDI(TIUK))
if 'TIUK
QUIT
Begin DoDot:2
+13 SET TIUDI("INST",TIUDI(TIUK))=TIUK
+14 SET TIUDI("ENTRIES")=$GET(TIUDI("ENTRIES"))_TIUK_";"
End DoDot:2
End DoDot:1
+15 IF '$TEST
SET TIUDI("ENTRIES")="ALL DIVISIONS"
+16 WRITE !
+17 SET TIU1TR=$$READ^TIUU("YA","Specific Transcriptionist(s)? ","NO","Indicate whether you would like to run the report for one or more specific Transcriptionists.")
+18 IF $DATA(DIRUT)
QUIT
+19 IF +TIU1TR
DO TRNSEL(.TIUTR)
if '+$GET(TIUTR)!+$GET(DIROUT)
QUIT
+20 WRITE !
+21 SET TIUSONLY=$$READ^TIUU("YA","Print Summary Page Only? ","NO","Indicate whether you would like to see only the Summary Page (i.e., no Details).")
+22 IF $DATA(DIRUT)
QUIT
+23 WRITE !
+24 SET TIUEDT=+$$EDATE^TIULA("Transcription","",$$DFLTDT("E"))
+25 WRITE !
+26 IF TIUEDT'>0
QUIT
+27 SET TIULDT=+$$LDATE^TIULA("Transcription","",$$DFLTDT("L"))
+28 WRITE !
+29 IF TIULDT'>0
QUIT
+30 SET ZTRTN="ENTRY^TIURVBC"
DEVICE ; Device handling
+1 ; Call with: ZTRTN
+2 NEW %ZIS
+3 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+4 if $DATA(IO("Q"))
GOTO QUE
NOQUE ; Call report directly
+1 DO @ZTRTN
+2 QUIT
QUE ; Queue output
+1 NEW %,ZTDTH,ZTIO,ZTSAVE,ZTSK
+2 if '$DATA(ZTRTN)
QUIT
+3 KILL IO("Q")
FOR %="DA","DFN","TIU*"
SET ZTSAVE(%)=""
+4 if '$DATA(ZTDESC)
SET ZTDESC="PRINT TRANSCRIPTION BILLING REPORT"
SET ZTIO=ION
+5 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+6 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+7 DO HOME^%ZIS
+8 QUIT
TRNSEL(TIUY) ; Select Transcriptionists
+1 NEW DIRUT,TIUQUIT,TIUPRSN,TIUI,TIUPRMT,TIUVBCUC,TIUSCRN,TIUHLP
SET (TIUY,TIUI,TIUQUIT)=0
+2 ; Identify User Class for VBC Line Count
+3 SET TIUVBCUC=$$GET^XPAR("DIV.`"_DUZ(2)_"^SYS","TIU USER CLASS FOR VBC")
+4 SET TIUHLP="Please choose a "_$SELECT(+TIUVBCUC:"KNOWN ",1:"")_"Transcriptionist (Duplicates not allowed)."
+5 SET TIUSCRN="I '$D(TIUY(""I"",+Y))"_$SELECT(+TIUVBCUC:",$$ISA^USRLM(+Y,TIUVBCUC)",1:"")
+6 WRITE !!,"Select Transcriptionist(s):",!
+7 FOR
Begin DoDot:1
+8 SET TIUI=TIUI+1
SET TIUPRMT=$JUSTIFY(TIUI,3)_") "
+9 SET TIUPRSN=$$READ^TIUU("PAO^200:AEMQ",TIUPRMT,"",TIUHLP,TIUSCRN)
+10 IF +TIUPRSN'>0
SET TIUQUIT=1
QUIT
+11 SET TIUY=TIUI
SET TIUY(TIUI)=TIUPRSN
SET TIUY("I",+TIUPRSN)=TIUI
End DoDot:1
if +TIUQUIT
QUIT
+12 WRITE !
+13 QUIT
ENTRY ; Build & Print Report
+1 NEW TIUA
+2 SET TIUA=$NAME(^TMP("TIURVBC",$JOB))
KILL @TIUA
+3 USE IO
+4 DO GATHER(.TIUDI,TIUA,TIUEDT,TIULDT,.TIUTR)
+5 DO REPORT(TIUA,TIUEDT,TIULDT,TIUSONLY)
+6 KILL @TIUA
+7 DO ^%ZISC
+8 QUIT
DFLTDT(EORL) ; Compute default early or late date
+1 NEW DOM,MON,YR,FMDT,DFLTDT
+2 SET YR=$EXTRACT(DT,1,3)
SET MON=$EXTRACT(DT,4,5)
SET DOM=$EXTRACT(DT,6,7)
+3 IF DOM<15
Begin DoDot:1
+4 IF +MON=1
SET MON=12
SET YR=YR-1
+5 IF '$TEST
SET MON=MON-1
if $LENGTH(MON)=1
SET MON="0"_MON
+6 SET DOM=$SELECT(EORL="E":"01",1:$$LDOM(MON,YR))
+7 SET FMDT=YR_MON_DOM_$SELECT(EORL="L":".2359",1:"")
End DoDot:1
IF 1
+8 IF '$TEST
Begin DoDot:1
+9 IF EORL="E"
SET DOM="01"
SET FMDT=YR_MON_DOM
+10 IF '$TEST
SET DFLTDT="NOW"
End DoDot:1
+11 IF $GET(DFLTDT)'="NOW"
SET DFLTDT=$$FMTE^XLFDT(FMDT)
+12 QUIT DFLTDT
LDOM(MON,YR) ; Calculate last day of month MON
+1 NEW LEAP,LDOMS
SET YR=1700+YR
SET LEAP=$$LEAP^XLFDT3(YR)
+2 SET LDOMS="31^"_(LEAP+28)_"^31^30^31^30^31^31^30^31^30^31"
+3 QUIT $PIECE(LDOMS,U,MON)
GATHER(TIUDI,TIUA,TIUEDT,TIULDT,TIUTR) ; Gather records that satisfy criteria
+1 NEW TIUTDT,TIUVBCUC
+2 ; Insure inclusive early date/time by subtracting one minute before $ORDER
+3 SET TIUTDT=$$FMADD^XLFDT(TIUEDT,0,0,-1)
+4 ; Insure inclusive end date/time by appending time of 23:59 if time not indicated
+5 IF $LENGTH(TIULDT,".")=1
SET $PIECE(TIULDT,".",2)="2359"
+6 FOR
SET TIUTDT=$ORDER(^TIU(8925,"VBC",TIUTDT))
if +TIUTDT'>0!(+TIUTDT>TIULDT)
QUIT
Begin DoDot:1
+7 NEW TIUVBC
SET TIUVBC=0
+8 FOR
SET TIUVBC=$ORDER(^TIU(8925,"VBC",TIUTDT,TIUVBC))
if +TIUVBC'>0
QUIT
Begin DoDot:2
+9 NEW TIUDA
SET TIUDA=0
+10 FOR
SET TIUDA=$ORDER(^TIU(8925,"VBC",TIUTDT,TIUVBC,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:3
+11 NEW TIUAUTH,TIUD0,TIUD12,TIUD13,TIUD14,TIUDIV,TIUEBY,TIUPTNM,TIUTITLE,TIUSVC,TIUPTL4
+12 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD12=$GET(^(12))
SET TIUD13=$GET(^(13))
SET TIUD14=$GET(^(14))
+13 SET TIUAUTH=$PIECE(TIUD12,U,2)
SET TIUDIV=$PIECE(TIUD12,U,12)
SET TIUEBY=$PIECE(TIUD13,U,2)
+14 SET TIUSVC=$PIECE(TIUD14,U,4)
+15 IF TIUAUTH=TIUEBY
QUIT
+16 IF +$GET(TIUTR)
IF '$DATA(TIUTR("I",+TIUEBY))
QUIT
+17 IF $SELECT(TIUDI("ENTRIES")="ALL DIVISIONS":0,$DATA(TIUDI("INST",+TIUDIV)):0,1:1)
QUIT
+18 ; Identify User Class for VBC Line Count
+19 SET TIUVBCUC=$$GET^XPAR($SELECT(TIUDIV]"":"DIV.`"_TIUDIV_"^",1:"")_"SYS","TIU USER CLASS FOR VBC")
+20 ; If User Class defined & document not entered by a member, quit to next document
+21 IF TIUVBCUC]""
IF '+$$ISA^USRLM(TIUEBY,TIUVBCUC)
QUIT
+22 SET TIUSVC=$SELECT(TIUSVC]"":$EXTRACT($$EXTERNAL^DILFD(8925,1404,"",TIUSVC),1,8),1:"UNKNOWN")
+23 SET TIUDIV=$SELECT(TIUDIV]"":$$EXTERNAL^DILFD(8925,1212,"",TIUDIV),1:"DIVISION UNKNOWN")
+24 SET TIUEBY=$SELECT(TIUEBY]"":$$LOW^XLFSTR($$INITIALS(TIUEBY)),1:"n/a")
+25 SET TIUTITLE=$EXTRACT($$PNAME^TIULC1($PIECE(TIUD0,U)),1,23)
+26 SET TIUAUTH=$SELECT(TIUAUTH]"":$$UP^XLFSTR($$INITIALS(TIUAUTH)),1:"N/A")
+27 SET TIUPTL4=$EXTRACT($$GET1^DIQ(2,$PIECE(TIUD0,U,2),.09),6,9)
if TIUPTL4']""
SET TIUPTL4="UNKN"
+28 SET TIUPTNM=$EXTRACT($$NAME^TIULS($$PTNAME^TIULC1($PIECE(TIUD0,U,2)),"LAST,FIRST MI"),1,19)_"|"_TIUPTL4
+29 SET @TIUA@(TIUDIV,TIUEBY,TIUTDT,TIUDA)=TIUTITLE_U_TIUPTNM_U_TIUAUTH_U_TIUVBC_U_TIUSVC
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT
INITIALS(TIUX) ; Get Person's initials from file 200
+1 NEW TIUY
SET TIUY=$$GET1^DIQ(200,TIUX,1)
+2 QUIT $SELECT($LENGTH(TIUY):TIUY,1:$$NAME^TIULS($$PERSNAME^TIULC1(TIUX),"FIMILI"))
REPORT(TIUA,TIUEDT,TIULDT,TIUSONLY) ; Generate report
+1 NEW TIUDIV,TIUDVBC,TIUDCNT,TIUSVBC,TIUSCNT,TIURTM,DIRUT,DTOUT,TIUSITE,TIUCAT,TIUI,TIUPG
+2 NEW TIUSHDR,EQLN
SET $PIECE(EQLN,"-",11)=""
SET TIUPG=0
SET TIUSONLY=+$GET(TIUSONLY)
+3 ; Tell TaskMan to delete Task log entry
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 USE IO
+5 SET TIURTM=$$NOW^XLFDT
SET TIUSITE=$SELECT($$NAME^VASITE]"":$$NAME^VASITE,1:$PIECE($$SITE^VASITE,U,2))
+6 IF '$DATA(@TIUA)
Begin DoDot:1
+7 DO HEADER("",TIURTM,TIUEDT,TIULDT,.TIUPG)
+8 if $$CONTINUE("",TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE !
+9 if $$CONTINUE("",TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE "No Documents Transcribed for selected Division(s) & Date Range...",!
+10 IF ($EXTRACT(IOST)="C")
IF ($EXTRACT(IOSL,1,3)'=999)
if '+$$STOP^TIUU("",1)
SET DIRUT=1
End DoDot:1
QUIT
+11 SET (TIUDIV,TIUSVBC,TIUSCNT)=0
+12 FOR
SET TIUDIV=$ORDER(@TIUA@(TIUDIV))
if TIUDIV']""
QUIT
Begin DoDot:1
+13 NEW TIUDTVBC,TIUEBY,TIUEBVBC,TIUEBCNT
SET TIUEBY=""
SET (TIUDVBC,TIUDCNT)=0
+14 if 'TIUSONLY
DO HEADER(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
+15 FOR
SET TIUEBY=$ORDER(@TIUA@(TIUDIV,TIUEBY))
if TIUEBY']""
QUIT
Begin DoDot:2
+16 NEW TIUTDT
SET (TIUDTVBC,TIUTDT)=0
+17 SET TIUEBCNT=+$PIECE($GET(@TIUA@(0,"EBY",TIUEBY)),U)
+18 SET TIUEBVBC=+$PIECE($GET(@TIUA@(0,"EBY",TIUEBY)),U,2)
+19 if 'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE TIUEBY
+20 FOR
SET TIUTDT=$ORDER(@TIUA@(TIUDIV,TIUEBY,TIUTDT))
if TIUTDT'>0
QUIT
Begin DoDot:3
+21 NEW TIUDA
SET TIUDA=0
+22 FOR
SET TIUDA=$ORDER(@TIUA@(TIUDIV,TIUEBY,TIUTDT,TIUDA))
if TIUDA'>0
QUIT
Begin DoDot:4
+23 NEW TIUD,TIUTITLE,TIUPTNM,TIUAUTH,TIUVBC,TIUSVC
+24 SET TIUD=$GET(@TIUA@(TIUDIV,TIUEBY,TIUTDT,TIUDA))
+25 SET TIUTITLE=$PIECE(TIUD,U)
SET TIUPTNM=$PIECE(TIUD,U,2)
SET TIUAUTH=$PIECE(TIUD,U,3)
SET TIUVBC=$PIECE(TIUD,U,4)
SET TIUSVC=$PIECE(TIUD,U,5)
+26 SET TIUDVBC=TIUDVBC+TIUVBC
SET TIUDCNT=TIUDCNT+1
SET @TIUA@(0,"Division",TIUDIV)=TIUDCNT_U_TIUDVBC
+27 SET TIUEBVBC=TIUEBVBC+TIUVBC
SET TIUEBCNT=TIUEBCNT+1
SET @TIUA@(0,"EBY",TIUEBY)=TIUEBCNT_U_TIUEBVBC
+28 SET TIUSVBC=TIUSVBC+TIUVBC
SET TIUSCNT=TIUSCNT+1
SET @TIUA@(0,"Station",TIUSITE)=TIUSCNT_U_TIUSVBC
+29 ; Transcriber total for this division
SET TIUDTVBC=TIUDTVBC+TIUVBC
+30 if 'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE ?5,$$DATE^TIULS(TIUTDT,"MM/DD/YY"),?14,TIUTITLE,?39,$PIECE(TIUPTNM,"|"),?59,"(",$PIECE(TIUPTNM,"|",2),")",?66,TIUAUTH,?70,$JUSTIFY(TIUVBC,10,2),!
End DoDot:4
if $DATA(DIRUT)
QUIT
End DoDot:3
if $DATA(DIRUT)
QUIT
+31 if $DATA(DIRUT)
QUIT
+32 if 'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE ?70,EQLN,!
+33 if 'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE ?42,"Total for Transcriber ",$JUSTIFY(TIUEBY,3)," = ",?70,$JUSTIFY(TIUDTVBC,10,2),!
+34 if 'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE !
End DoDot:2
if $DATA(DIRUT)
QUIT
+35 if $DATA(DIRUT)
QUIT
+36 if 'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE ?70,EQLN,!
+37 if 'TIUSONLY&$$CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE ?49,"Total for Division = ",?70,$JUSTIFY(TIUDVBC,10,2),!
+38 IF 'TIUSONLY
IF ($EXTRACT(IOST)="C")
IF ($EXTRACT(IOSL,1,3)'=999)
if '+$$STOP^TIUU("",1)
SET DIRUT=1
End DoDot:1
if $DATA(DIRUT)
QUIT
+39 IF $DATA(DIRUT)!'$DATA(@TIUA@(0))
QUIT
+40 ;Summarize
+41 SET TIUCAT=""
SET TIUSHDR="SUMMARY for "_TIUSITE
+42 DO HEADER(TIUSHDR,TIURTM,TIUEDT,TIULDT,.TIUPG)
+43 FOR
SET TIUCAT=$ORDER(@TIUA@(0,TIUCAT))
if TIUCAT']""
QUIT
Begin DoDot:1
+44 if $$CONTINUE(TIUSHDR,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE !,$SELECT(TIUCAT="EBY":"Transcriber",1:TIUCAT)," Totals",!
+45 SET TIUI=""
FOR
SET TIUI=$ORDER(@TIUA@(0,TIUCAT,TIUI))
if TIUI']""
QUIT
Begin DoDot:2
+46 NEW TIUR
SET TIUR=@TIUA@(0,TIUCAT,TIUI)
+47 if $$CONTINUE(TIUSHDR,TIURTM,TIUEDT,TIULDT,.TIUPG)
WRITE ?2,TIUI,?48,$PIECE(TIUR,U),?70,$JUSTIFY($PIECE(TIUR,U,2),10,2),!
End DoDot:2
End DoDot:1
if $DATA(DIRUT)
QUIT
+48 IF ($EXTRACT(IOST)="C")
IF ($EXTRACT(IOSL,1,3)'=999)
if '+$$STOP^TIUU("",1)
SET DIRUT=1
+49 QUIT
CONTINUE(TIUDIV,TIURTM,TIUEDT,TIULDT,TIUPG) ; Evaluate relative page position
+1 NEW TIUY
SET TIUY=1
+2 IF $Y'>(IOSL-3)
GOTO CONTX
+3 IF $EXTRACT(IOST)="C"
SET TIUY=+$$READ^TIUU("E")
IF $DATA(DIRUT)!(TIUY'>0)
GOTO CONTX
+4 DO HEADER(TIUDIV,TIURTM,TIUEDT,TIULDT,.TIUPG)
CONTX QUIT TIUY
+1 NEW TIULINE,TIUDTR
SET $PIECE(TIULINE,"=",81)=""
SET TIUDTR=$$DATE^TIULS(TIUEDT,"MM/DD/CCYY")_" to "_$$DATE^TIULS(TIULDT,"MM/DD/CCYY")
+2 SET TIUPG=TIUPG+1
+3 WRITE @IOF
DO JUSTIFY^TIUU("Page "_TIUPG,"R")
WRITE !
+4 WRITE TIULINE,!
DO JUSTIFY^TIUU($$TITLE^TIUU("TRANSCRIPTION BILLING REPORT"),"C")
WRITE !
+5 DO JUSTIFY^TIUU(DIVISION,"C")
+6 WRITE !
+7 WRITE "for Documents Transcribed: ",TIUDTR,?55,"Printed: ",$$DATE^TIULS(TIURTM,"MM/DD/CCYY HR:MIN"),!
+8 WRITE !
+9 IF DIVISION'["SUMMARY"
WRITE "Tran",?5,"Date",?14,"Title",?39,"Patient",?66,"Aut",?71,"VBC Lines",!
+10 WRITE TIULINE,!
+11 IF '$TEST
WRITE "Category",?48,"Documents",?71,"VBC Lines",!,TIULINE
+12 QUIT
