- LRTT5R1 ;DALISC/FHS - LAB URGENCY TURNAROUND TIMES REPORT GENERATOR ; 12/3/1997
- ;;5.2;LAB SERVICE;**153,201,274**;Sep 27, 1994
- ONE ; from LRTT5
- ; input LRPQ(, ^TMP("LR",$J processed from LRTT5P1
- S LREND=0
- I $O(LRLLOC(0)) W !?10," Institution included in report:" D
- . S I=0 F S I=$O(LRLLOC(I)) Q:I<1 W !?20,$P(LRLLOC(I),U,2)
- F LRPTYPE="REG","IRREG" D W !
- .W !," Turnaround Time (TAT) - ",$S(LRPTYPE="REG":"Regular (0701-1700) ",1:"Irregular")," hours",!
- .W !," Number of tests Total time Ave TAT"
- .W !," ---------------------- ---------- -------"
- .W !,?12,+^TMP("LR",$J,LRPTYPE),?35,+$P(^TMP("LR",$J,LRPTYPE),U,2)," min" I +^TMP("LR",$J,LRPTYPE) W ?57,+$P(^TMP("LR",$J,LRPTYPE),U,2)\+^TMP("LR",$J,LRPTYPE)," min"
- W "Urgencies:" S LRX=0 F S LRX=$O(LRPQ("URGENCY",LRX)) Q:LRX<1 W !?5,LRPQ("URGENCY",LRX)
- W !!,"Tests:" S LRX=0 F S LRX=$O(^TMP("LRTT5",$J,"TESTS",LRX)) Q:LRX<1 W !?5,^(LRX)
- I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
- CHK I 'LRPDET D CLEANUP Q
- SHEAD ;S LRPDHEAD="Test Number of Tests Total TAT Ave TAT",LRPPAGE=0 D DHDR^LRTT5
- ;F LRPTYPE="REGT","IRREGT" Q:$G(LREND) D
- ;. D LNCHECK^LRTT5 Q:$G(LREND) W !,$S(LRPTYPE="REGT":"Regular",1:"Irregular")," hours" S LRTEST="" F S LRTEST=$O(^TMP("LR",$J,LRPTYPE,LRTEST)) Q:LRTEST=""!($G(LREND)) S LRX=^(LRTEST) D
- ;. . D LNCHECK^LRTT5 Q:$G(LREND) W !,LRTEST,?25,$J(+LRX,9,0),?37,$J(+$P(LRX,U,2),9,0) I +LRX W ?50,$J($P(LRX,U,2)/+LRX,9,1)
- ;I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
- S LRPDHEAD="TAT Acc Test In Out" D DHDR^LRTT5 Q:$G(LREND)
- TYPE F LRPDTYPE="BAD","REG","IRREG" Q:$G(LREND) D
- .D LNCHECK^LRTT5 Q:$G(LREND) W !!,$S(LRPDTYPE="BAD":"Tests not counted:",LRPDTYPE="REG":"Regular hours:",1:"Irregular hours:"),!
- .S LRPCNT=0,LRPDIFF="" F S LRPDIFF=$O(^TMP("LR",$J,LRPDTYPE,LRPDIFF)) Q:LRPDIFF="" D
- . . S LRPN="" F S LRPN=$O(^TMP("LR",$J,LRPDTYPE,LRPDIFF,LRPN)) Q:LRPN="" S LRPLINE=^(LRPN),LRPCNT=LRPCNT+1 D
- . . . D LNCHECK^LRTT5 Q:$G(LREND)
- . . . W ! W:$L($P(LRPLINE,U,4)) LRPDIFF W ?6,$P(LRPLINE,U),?21,$E($P(LRPLINE,U,2),1,15),?37,$$FMTE^XLFDT($E($P(LRPLINE,U,3),1,12)) I $L($P(LRPLINE,U,4)) W ?58,$$FMTE^XLFDT($E($P(LRPLINE,U,4),1,12))
- .I 'LRPCNT W !,"none found",!
- I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
- D CLEANUP
- Q
- CLEANUP ;
- STOP K ^TMP("LR",$J),LRPCNT,LRPDET,LRPDHEAD,LRPDIFF,LRPDTYPE,LRPLINE,LRPN,LRPPAGE,LRPQ,LRTEST,LRPTYPE,LRX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRTT5R1 2595 printed Feb 18, 2025@23:47:04 Page 2
- LRTT5R1 ;DALISC/FHS - LAB URGENCY TURNAROUND TIMES REPORT GENERATOR ; 12/3/1997
- +1 ;;5.2;LAB SERVICE;**153,201,274**;Sep 27, 1994
- ONE ; from LRTT5
- +1 ; input LRPQ(, ^TMP("LR",$J processed from LRTT5P1
- +2 SET LREND=0
- +3 IF $ORDER(LRLLOC(0))
- WRITE !?10," Institution included in report:"
- Begin DoDot:1
- +4 SET I=0
- FOR
- SET I=$ORDER(LRLLOC(I))
- if I<1
- QUIT
- WRITE !?20,$PIECE(LRLLOC(I),U,2)
- End DoDot:1
- +5 FOR LRPTYPE="REG","IRREG"
- Begin DoDot:1
- +6 WRITE !," Turnaround Time (TAT) - ",$SELECT(LRPTYPE="REG":"Regular (0701-1700) ",1:"Irregular")," hours",!
- +7 WRITE !," Number of tests Total time Ave TAT"
- +8 WRITE !," ---------------------- ---------- -------"
- +9 WRITE !,?12,+^TMP("LR",$JOB,LRPTYPE),?35,+$PIECE(^TMP("LR",$JOB,LRPTYPE),U,2)," min"
- IF +^TMP("LR",$JOB,LRPTYPE)
- WRITE ?57,+$PIECE(^TMP("LR",$JOB,LRPTYPE),U,2)\+^TMP("LR",$JOB,LRPTYPE)," min"
- End DoDot:1
- WRITE !
- +10 WRITE "Urgencies:"
- SET LRX=0
- FOR
- SET LRX=$ORDER(LRPQ("URGENCY",LRX))
- if LRX<1
- QUIT
- WRITE !?5,LRPQ("URGENCY",LRX)
- +11 WRITE !!,"Tests:"
- SET LRX=0
- FOR
- SET LRX=$ORDER(^TMP("LRTT5",$JOB,"TESTS",LRX))
- if LRX<1
- QUIT
- WRITE !?5,^(LRX)
- +12 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if $GET(DIRUT)
- SET LREND=1
- if LREND
- QUIT
- CHK IF 'LRPDET
- DO CLEANUP
- QUIT
- SHEAD ;S LRPDHEAD="Test Number of Tests Total TAT Ave TAT",LRPPAGE=0 D DHDR^LRTT5
- +1 ;F LRPTYPE="REGT","IRREGT" Q:$G(LREND) D
- +2 ;. D LNCHECK^LRTT5 Q:$G(LREND) W !,$S(LRPTYPE="REGT":"Regular",1:"Irregular")," hours" S LRTEST="" F S LRTEST=$O(^TMP("LR",$J,LRPTYPE,LRTEST)) Q:LRTEST=""!($G(LREND)) S LRX=^(LRTEST) D
- +3 ;. . D LNCHECK^LRTT5 Q:$G(LREND) W !,LRTEST,?25,$J(+LRX,9,0),?37,$J(+$P(LRX,U,2),9,0) I +LRX W ?50,$J($P(LRX,U,2)/+LRX,9,1)
- +4 ;I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
- +5 SET LRPDHEAD="TAT Acc Test In Out"
- DO DHDR^LRTT5
- if $GET(LREND)
- QUIT
- TYPE FOR LRPDTYPE="BAD","REG","IRREG"
- if $GET(LREND)
- QUIT
- Begin DoDot:1
- +1 DO LNCHECK^LRTT5
- if $GET(LREND)
- QUIT
- WRITE !!,$SELECT(LRPDTYPE="BAD":"Tests not counted:",LRPDTYPE="REG":"Regular hours:",1:"Irregular hours:"),!
- +2 SET LRPCNT=0
- SET LRPDIFF=""
- FOR
- SET LRPDIFF=$ORDER(^TMP("LR",$JOB,LRPDTYPE,LRPDIFF))
- if LRPDIFF=""
- QUIT
- Begin DoDot:2
- +3 SET LRPN=""
- FOR
- SET LRPN=$ORDER(^TMP("LR",$JOB,LRPDTYPE,LRPDIFF,LRPN))
- if LRPN=""
- QUIT
- SET LRPLINE=^(LRPN)
- SET LRPCNT=LRPCNT+1
- Begin DoDot:3
- +4 DO LNCHECK^LRTT5
- if $GET(LREND)
- QUIT
- +5 WRITE !
- if $LENGTH($PIECE(LRPLINE,U,4))
- WRITE LRPDIFF
- WRITE ?6,$PIECE(LRPLINE,U),?21,$EXTRACT($PIECE(LRPLINE,U,2),1,15),?37,$$FMTE^XLFDT($EXTRACT($PIECE(LRPLINE,U,3),1,12))
- IF $LENGTH($PIECE(LRPLINE,U,4))
- WRITE ?58,$$FMTE^XLFDT($EXTRACT($PIECE(LRPLINE,U,4),1,12))
- End DoDot:3
- End DoDot:2
- +6 IF 'LRPCNT
- WRITE !,"none found",!
- End DoDot:1
- +7 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if $GET(DIRUT)
- SET LREND=1
- if LREND
- QUIT
- +8 DO CLEANUP
- +9 QUIT
- CLEANUP ;
- STOP KILL ^TMP("LR",$JOB),LRPCNT,LRPDET,LRPDHEAD,LRPDIFF,LRPDTYPE,LRPLINE,LRPN,LRPPAGE,LRPQ,LRTEST,LRPTYPE,LRX
- +1 QUIT
