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 Apr 09, 2024@21:21:41 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
