- 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 Feb 19, 2025@00:12:06 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