Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURVBC

TIURVBC.m

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