- LRTT5 ;DALISC/FHS - LAB URGENCY TURNAROUND TIMES ; 12/3/1997
- ;;5.2;LAB SERVICE;**153,201**;Sep 27, 1994
- EN ;
- ONE S LREND=0 D ^LRPARAM G:$G(LREND) STOP
- S LRPTITLE="Urgency Turnaround Time",LRPQNUM=1 K LRPQ
- ; from LRTT5
- ; get default dates from QUIC Extract file - if current survey
- W @IOF S LRPOPTN="",LREDT=LRDT0
- D TITLE("TQD")
- D ^LRWU3 G:$G(LREND) STOP S LRPSDT=LRSDT,LRPEDT=LREDT
- W !!,"Select the laboratory tests to be used in this report --",!
- K DIC,^TMP("LRTT5",$J) S DIC=60,DIC(0)="AEMOQZ",DIC("A")=" LABORATORY TEST: "
- S ^TMP("LRTT5",$J,0)=DT_U_DT_U_"LAB URGENCY TURNAROUND TIMES"
- F D ^DIC Q:Y<1 S ^TMP("LRTT5",$J,"TESTS",+Y)=$P(Y(0),U)
- K DIC I '$D(^TMP("LRTT5",$J,"TESTS")) G STOP
- W !!,"Urgencies:" S LRX=0 F S LRX=$O(^LAB(62.05,LRX)) Q:LRX>49!(LRX<1) W:$D(^(LRX,0)) !?10,$P(^(0),U)
- W !,"Enter all urgencies you want extracted." S DIC=62.05,DIC(0)="AEMOQZ",DIC("A")=" URGENCY: ",DIC("S")="I +Y<49"
- F D ^DIC Q:Y<1 S LRPQ("URGENCY",+Y)=$P(Y(0),U) S:$D(^LAB(62.05,(+Y+50),0)) LRPQ("URGENCY",(+Y+50))=$P(^(0),U)
- K DIC I '$D(LRPQ("URGENCY")) G STOP
- K DIC,DIR S DIR(0)="PO^DIC(4,:AENM",DIR("A")="Select Division(s) "
- W !!?10,"<Optional Screen> Press return to select all divisions",! D
- . F D READ Q:$G(LREND)!(Y<1) S LRLLOC(+Y)=Y
- I $D(LRPQ) D DETAIL I LRPDET<0 K LRPQ
- I $D(LRPQ) D DEV
- D CLEANUP
- Q
- DETAIL ; detailed report=1, no detailed report=0, exit=-1
- F W !!,"Include a detailed report" S %=2 D YN^DICN Q:% W " enter 'Y'es or 'N'o"
- S LRPDET=$S(%=1:1,%=2:0,1:-1)
- Q
- DEV ;
- W !! S %ZIS="Q" D ^%ZIS I POP Q
- I '$D(IO("Q")) D REPORT Q
- S ZTIO=ION,ZTSAVE("^TMP(""LRTT5"",$J,")="",ZTSAVE("LR*")="",ZTDESC="LAB - "_LRPTITLE,ZTRTN="REPORT^LRTT5" D ^%ZTLOAD W !,$S($D(ZTSK):"Request queued",1:"Request canceled") D HOME^%ZIS K ZTSK Q
- Q
- REPORT ; dequeued
- K ^TMP("LR",$J) S ^TMP("LR",$J,0)=DT_U_DT_U_"LAB URGENCY TURNAROUND TIMES"
- D ONE^LRTT5P1
- S LRPNOW=$$NOW^XLFDT,LRPTBF=$$FMTE^XLFDT(LRPSDT),LRPTEF=$$FMTE^XLFDT(LRPEDT)
- U IO W:$E(IOST,1,2)="C-" @IOF D HDR
- I $O(^TMP("LR",$J,0))="" W !!!,"No data to report" G CLEANUP
- D ONE^LRTT5R1
- I '$G(LREND) W !!?20,"****** END OF REPORT ********"
- D CLEANUP
- Q
- LNCHECK ; from LRTT5R*
- Q:$G(LREND) I $Y>(IOSL-6) D
- . I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND D DHDR Q
- . D DHDR
- Q
- DHDR ; from LRTT5R*
- Q:$G(LREND) W @IOF D HDR S LRPPAGE=$G(LRPPAGE)+1,LRPDTHDR="LEDI - "_LRPTITLE_" - DETAILED " W ?(IOM-$L(LRPDTHDR)\2),LRPDTHDR,?(IOM-15),"PAGE ",LRPPAGE,!,LRPDHEAD,!
- Q
- HDR Q:$G(LREND)
- F LRPLN=$G(LRPVAMC),"LEDI Management Report - "_LRPTITLE,"From "_LRPTBF_" To "_LRPTEF,"Date Printed: "_$$FMTE^XLFDT($$NOW^XLFDT) W !?(IOM-$L(LRPLN)\2),LRPLN
- S LRPLN="",$P(LRPLN,"_",IOM+1)="" W !,LRPLN,!
- Q
- CLEANUP ;
- STOP K ^TMP("LR",$J),^TMP("LRTT5",$J) I $D(ZTQUEUED) S ZTREQ="@"
- W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
- K %,%I,%DT,%ZIS,%T,%Y,C,DIC,DFN,DTOUT,DUOUT,POP,DIR,LRPVAMC
- K LRAA,LRAASUB,LRAAT,LRPAC,LRPALOC,LRPALRSP,LRAN,LRPCNT,LRPDET,LRDPF
- K LRPDHEAD,LRPDIFF,LRPDNODE,LRPDTHDR,LRPDTYPE,LRPITB,LRPITE,LRAD,LRPLINE,LRPLN
- K LRLOC,LRLLOC,LRLOC44,LRLOCX,LRPLRAC,LRPLRDC,LRPLRDFN,LRPLRDN,LRPLRIDT,LRPLRRX,LRPLRRX1,LRPLRRX2
- K LRPLRSP,LRPLRSS,LRPLRST,LRPLRT,LRPLRTN,LRPLRTS,LRPMERGE,LRPN,LRPNN,LRPNNUM,LRPNOW
- K LRPNT,LRPNUM,LRPOC,LRPOCM,LRPOCNT,LRPOCT,LRPOCTT,LRPOK,LRPOOS,LRPORG,LRPORGN,LRPOS,LRPPAGE
- K LRPPATN,LRPPDOC,LRPQ,LRPQNUM,LRPRX1D,LRPRX1T,LRPSP,LRPSPEC,LRPSPN,LRPTB,LRPTBF
- K LRPTE,LRPTEF,LRTEST,LRTESTN,LRPTITLE,LRPTYPE,LRX,LREDT,LRSDT
- K LRPERR,VA,VADM,VAIN,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK,LRPSDT
- K LRPEDT,LRPOPTN,LREND
- Q
- LRTT5U ;
- TITLE(LRPUTYPE) ; from LRTT5, LRTT5A, displays "T" title, "Q" question, "D" description
- I LRPUTYPE["T" S LRPLN="LEDI Utility - "_LRPTITLE W !!?(IOM-$L(LRPLN)\2),LRPLN,!
- I LRPUTYPE["D" D
- .I LRPQNUM=1 F LRPOS=1:1 S LRPLN=$P($T(ONED+LRPOS),";;",2) Q:LRPLN="" W !,$$CJ^XLFSTR(LRPLN,IOM)
- .W !!
- Q
- ONED ; description 1
- ;;This option generates a report of the turnaround time for selected lab
- ;;tests. Enter only those urgencies you want extracted. WKLD urgencies will
- ;;be included for each normal urgency selected. Enter the
- ;;test(s) you want the report display.
- ;; -
- ;;A detailed report is available to show the data being used to
- ;;compute the turnaround times.
- ;; -
- ;;Regular hours are from 7:01 AM to 5:00PM
- ;;Irregular hours includes all other times, holidays and weekends.
- ;;
- ;
- ;
- Q
- READ ;
- D ^DIR S:$D(DTOUT)!($D(DUOUT)) LREND=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRTT5 4515 printed Feb 18, 2025@23:47:02 Page 2
- LRTT5 ;DALISC/FHS - LAB URGENCY TURNAROUND TIMES ; 12/3/1997
- +1 ;;5.2;LAB SERVICE;**153,201**;Sep 27, 1994
- EN ;
- ONE SET LREND=0
- DO ^LRPARAM
- if $GET(LREND)
- GOTO STOP
- +1 SET LRPTITLE="Urgency Turnaround Time"
- SET LRPQNUM=1
- KILL LRPQ
- +2 ; from LRTT5
- +3 ; get default dates from QUIC Extract file - if current survey
- +4 WRITE @IOF
- SET LRPOPTN=""
- SET LREDT=LRDT0
- +5 DO TITLE("TQD")
- +6 DO ^LRWU3
- if $GET(LREND)
- GOTO STOP
- SET LRPSDT=LRSDT
- SET LRPEDT=LREDT
- +7 WRITE !!,"Select the laboratory tests to be used in this report --",!
- +8 KILL DIC,^TMP("LRTT5",$JOB)
- SET DIC=60
- SET DIC(0)="AEMOQZ"
- SET DIC("A")=" LABORATORY TEST: "
- +9 SET ^TMP("LRTT5",$JOB,0)=DT_U_DT_U_"LAB URGENCY TURNAROUND TIMES"
- +10 FOR
- DO ^DIC
- if Y<1
- QUIT
- SET ^TMP("LRTT5",$JOB,"TESTS",+Y)=$PIECE(Y(0),U)
- +11 KILL DIC
- IF '$DATA(^TMP("LRTT5",$JOB,"TESTS"))
- GOTO STOP
- +12 WRITE !!,"Urgencies:"
- SET LRX=0
- FOR
- SET LRX=$ORDER(^LAB(62.05,LRX))
- if LRX>49!(LRX<1)
- QUIT
- if $DATA(^(LRX,0))
- WRITE !?10,$PIECE(^(0),U)
- +13 WRITE !,"Enter all urgencies you want extracted."
- SET DIC=62.05
- SET DIC(0)="AEMOQZ"
- SET DIC("A")=" URGENCY: "
- SET DIC("S")="I +Y<49"
- +14 FOR
- DO ^DIC
- if Y<1
- QUIT
- SET LRPQ("URGENCY",+Y)=$PIECE(Y(0),U)
- if $DATA(^LAB(62.05,(+Y+50),0))
- SET LRPQ("URGENCY",(+Y+50))=$PIECE(^(0),U)
- +15 KILL DIC
- IF '$DATA(LRPQ("URGENCY"))
- GOTO STOP
- +16 KILL DIC,DIR
- SET DIR(0)="PO^DIC(4,:AENM"
- SET DIR("A")="Select Division(s) "
- +17 WRITE !!?10,"<Optional Screen> Press return to select all divisions",!
- Begin DoDot:1
- +18 FOR
- DO READ
- if $GET(LREND)!(Y<1)
- QUIT
- SET LRLLOC(+Y)=Y
- End DoDot:1
- +19 IF $DATA(LRPQ)
- DO DETAIL
- IF LRPDET<0
- KILL LRPQ
- +20 IF $DATA(LRPQ)
- DO DEV
- +21 DO CLEANUP
- +22 QUIT
- DETAIL ; detailed report=1, no detailed report=0, exit=-1
- +1 FOR
- WRITE !!,"Include a detailed report"
- SET %=2
- DO YN^DICN
- if %
- QUIT
- WRITE " enter 'Y'es or 'N'o"
- +2 SET LRPDET=$SELECT(%=1:1,%=2:0,1:-1)
- +3 QUIT
- DEV ;
- +1 WRITE !!
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- QUIT
- +2 IF '$DATA(IO("Q"))
- DO REPORT
- QUIT
- +3 SET ZTIO=ION
- SET ZTSAVE("^TMP(""LRTT5"",$J,")=""
- SET ZTSAVE("LR*")=""
- SET ZTDESC="LAB - "_LRPTITLE
- SET ZTRTN="REPORT^LRTT5"
- DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request queued",1:"Request canceled")
- DO HOME^%ZIS
- KILL ZTSK
- QUIT
- +4 QUIT
- REPORT ; dequeued
- +1 KILL ^TMP("LR",$JOB)
- SET ^TMP("LR",$JOB,0)=DT_U_DT_U_"LAB URGENCY TURNAROUND TIMES"
- +2 DO ONE^LRTT5P1
- +3 SET LRPNOW=$$NOW^XLFDT
- SET LRPTBF=$$FMTE^XLFDT(LRPSDT)
- SET LRPTEF=$$FMTE^XLFDT(LRPEDT)
- +4 USE IO
- if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- DO HDR
- +5 IF $ORDER(^TMP("LR",$JOB,0))=""
- WRITE !!!,"No data to report"
- GOTO CLEANUP
- +6 DO ONE^LRTT5R1
- +7 IF '$GET(LREND)
- WRITE !!?20,"****** END OF REPORT ********"
- +8 DO CLEANUP
- +9 QUIT
- LNCHECK ; from LRTT5R*
- +1 if $GET(LREND)
- QUIT
- IF $Y>(IOSL-6)
- Begin DoDot:1
- +2 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if $GET(DIRUT)
- SET LREND=1
- if LREND
- QUIT
- DO DHDR
- QUIT
- +3 DO DHDR
- End DoDot:1
- +4 QUIT
- DHDR ; from LRTT5R*
- +1 if $GET(LREND)
- QUIT
- WRITE @IOF
- DO HDR
- SET LRPPAGE=$GET(LRPPAGE)+1
- SET LRPDTHDR="LEDI - "_LRPTITLE_" - DETAILED "
- WRITE ?(IOM-$LENGTH(LRPDTHDR)\2),LRPDTHDR,?(IOM-15),"PAGE ",LRPPAGE,!,LRPDHEAD,!
- +2 QUIT
- HDR if $GET(LREND)
- QUIT
- +1 FOR LRPLN=$GET(LRPVAMC),"LEDI Management Report - "_LRPTITLE,"From "_LRPTBF_" To "_LRPTEF,"Date Printed: "_$$FMTE^XLFDT($$NOW^XLFDT)
- WRITE !?(IOM-$LENGTH(LRPLN)\2),LRPLN
- +2 SET LRPLN=""
- SET $PIECE(LRPLN,"_",IOM+1)=""
- WRITE !,LRPLN,!
- +3 QUIT
- CLEANUP ;
- STOP KILL ^TMP("LR",$JOB),^TMP("LRTT5",$JOB)
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 WRITE !!
- if $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- DO ^%ZISC
- +2 KILL %,%I,%DT,%ZIS,%T,%Y,C,DIC,DFN,DTOUT,DUOUT,POP,DIR,LRPVAMC
- +3 KILL LRAA,LRAASUB,LRAAT,LRPAC,LRPALOC,LRPALRSP,LRAN,LRPCNT,LRPDET,LRDPF
- +4 KILL LRPDHEAD,LRPDIFF,LRPDNODE,LRPDTHDR,LRPDTYPE,LRPITB,LRPITE,LRAD,LRPLINE,LRPLN
- +5 KILL LRLOC,LRLLOC,LRLOC44,LRLOCX,LRPLRAC,LRPLRDC,LRPLRDFN,LRPLRDN,LRPLRIDT,LRPLRRX,LRPLRRX1,LRPLRRX2
- +6 KILL LRPLRSP,LRPLRSS,LRPLRST,LRPLRT,LRPLRTN,LRPLRTS,LRPMERGE,LRPN,LRPNN,LRPNNUM,LRPNOW
- +7 KILL LRPNT,LRPNUM,LRPOC,LRPOCM,LRPOCNT,LRPOCT,LRPOCTT,LRPOK,LRPOOS,LRPORG,LRPORGN,LRPOS,LRPPAGE
- +8 KILL LRPPATN,LRPPDOC,LRPQ,LRPQNUM,LRPRX1D,LRPRX1T,LRPSP,LRPSPEC,LRPSPN,LRPTB,LRPTBF
- +9 KILL LRPTE,LRPTEF,LRTEST,LRTESTN,LRPTITLE,LRPTYPE,LRX,LREDT,LRSDT
- +10 KILL LRPERR,VA,VADM,VAIN,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK,LRPSDT
- +11 KILL LRPEDT,LRPOPTN,LREND
- +12 QUIT
- LRTT5U ;
- TITLE(LRPUTYPE) ; from LRTT5, LRTT5A, displays "T" title, "Q" question, "D" description
- +1 IF LRPUTYPE["T"
- SET LRPLN="LEDI Utility - "_LRPTITLE
- WRITE !!?(IOM-$LENGTH(LRPLN)\2),LRPLN,!
- +2 IF LRPUTYPE["D"
- Begin DoDot:1
- +3 IF LRPQNUM=1
- FOR LRPOS=1:1
- SET LRPLN=$PIECE($TEXT(ONED+LRPOS),";;",2)
- if LRPLN=""
- QUIT
- WRITE !,$$CJ^XLFSTR(LRPLN,IOM)
- +4 WRITE !!
- End DoDot:1
- +5 QUIT
- ONED ; description 1
- +1 ;;This option generates a report of the turnaround time for selected lab
- +2 ;;tests. Enter only those urgencies you want extracted. WKLD urgencies will
- +3 ;;be included for each normal urgency selected. Enter the
- +4 ;;test(s) you want the report display.
- +5 ;; -
- +6 ;;A detailed report is available to show the data being used to
- +7 ;;compute the turnaround times.
- +8 ;; -
- +9 ;;Regular hours are from 7:01 AM to 5:00PM
- +10 ;;Irregular hours includes all other times, holidays and weekends.
- +11 ;;
- +12 ;
- +13 ;
- +14 QUIT
- READ ;
- +1 DO ^DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- SET LREND=1
- +2 QUIT
