RADLQ2 ;HISC/GJC-Delq Status/Incomplete Rpt's ;3/6/97 08:50
;;5.0;Radiology/Nuclear Medicine;**15,47**;Mar 16, 1998;Build 21
DATE ; Sort by date
S RADIV="" F S RADIV=$O(^TMP($J,"RADLQ",RADIV)) Q:RADIV']"" D Q:RAXIT
. S RA1=$P($G(^DIC(4,RADIV,0)),"^"),RAITYPE=""
. F S RAITYPE=$O(^TMP($J,"RADLQ",RADIV,RAITYPE)) Q:RAITYPE']"" D Q:RAXIT
.. S RA2=RAITYPE,RAVAR=""
.. F S RAVAR=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR)) Q:RAVAR']"" D Q:RAXIT
... S RADTE=0
... F S RADTE=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE)) Q:RADTE'>0 D Q:RAXIT
.... S RANME=""
.... F S RANME=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE,RANME)) Q:RANME']"" D Q:RAXIT
..... S RACN=0
..... F S RACN=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE,RANME,RACN)) Q:RACN'>0 D Q:RAXIT
...... S RANODE=$G(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE,RANME,RACN))
...... D:RANODE]"" OUTPUT^RADLQ3
...... Q
..... Q
.... Q
... Q
.. D:'RAXIT IMGCHK
.. Q
. D:'RAXIT DIVCHK
. Q
Q
HDR ; Header for reports
I RAPG!($E(IOST,1,2)="C-") W @IOF
S RAPG=RAPG+1 W !?(IOM-$L(RAHD(0))\2),RAHD(0)
W !,"Division: ",$S($D(RAFLAG):"",1:RA1),?RATAB("HEAD"),"Page: ",RAPG
W !,"Imaging Type: ",$S($D(RAFLAG):"",1:RA2),?RATAB("HEAD"),"Date: "
W $$FMTE^XLFDT($$DT^XLFDT,1)
W !,RALN2
I $$USESSAN^RAHLRU1() W !,"Patient Name",?RATAB(1),"Case #",?RATAB(2)+6,"Pt ID"
I '$$USESSAN^RAHLRU1() W !,"Patient Name",?RATAB(1),"Case #",?RATAB(2),"Pt ID"
W ?RATAB(3),"Date",?RATAB(4),"Ward/Clinic"
W ?RATAB(5),"Rpt Stat",!?RATAB(6),"Procedure"
W ?RATAB(7),"Exam Status",?RATAB(8),"Rpt Text"
W ?RATAB(9),"Interp. Phys.",?RATAB(10),"Tech",!,RALN2
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
Q
PATIENT ; Sort by patient
S RADIV="" F S RADIV=$O(^TMP($J,"RADLQ",RADIV)) Q:RADIV']"" D Q:RAXIT
. S RA1=$P($G(^DIC(4,RADIV,0)),"^"),RAITYPE=""
. F S RAITYPE=$O(^TMP($J,"RADLQ",RADIV,RAITYPE)) Q:RAITYPE']"" D Q:RAXIT
.. S RA2=RAITYPE,RAVAR=""
.. F S RAVAR=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR)) Q:RAVAR']"" D Q:RAXIT
... S RANME=""
... F S RANME=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RANME)) Q:RANME']"" D Q:RAXIT
.... S RADTE=0
.... F S RADTE=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RANME,RADTE)) Q:RADTE'>0 D Q:RAXIT
..... S RACN=0
..... F S RACN=$O(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RANME,RADTE,RACN)) Q:RACN'>0 D Q:RAXIT
...... S RANODE=$G(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,RANME,RADTE,RACN))
...... D:RANODE]"" OUTPUT^RADLQ3
...... Q
..... Q
.... Q
... Q
.. D:'RAXIT IMGCHK
.. Q
. D:'RAXIT DIVCHK
. Q
Q
PRINT ; Outputting the data
S RATAB(1)=$S(IOM=132:40,1:22),RATAB(2)=$S(IOM=132:54,1:32)
S RATAB(3)=$S(IOM=132:74,1:45),RATAB(4)=$S(IOM=132:90,1:55)
S RATAB(5)=$S(IOM=132:120,1:72),RATAB(6)=1 ; for 132 & 80 column
S RATAB(7)=$S(IOM=132:40,1:23),RATAB(8)=$S(IOM=132:75,1:36)
S RATAB(9)=$S(IOM=132:90,1:46),RATAB(10)=$S(IOM=132:114,1:63)
S RATAB("HEAD")=$S(IOM=132:102,1:62)
S RADIV=$O(^TMP($J,"RADLQ","")),RA2=$O(^TMP($J,"RADLQ",RADIV,""))
S RA1=$P($G(^DIC(4,RADIV,0)),"^") D HDR
D @$S(RASORT2="P":"PATIENT",1:"DATE")
Q
DIVCHK ; Output statistics within division
N RA3 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR Q:RAXIT
W !!?RATAB(6),"Division Total '"_RA1_"': ",+$G(^TMP($J,"RADLQ",RADIV))
S RA3=+$O(^TMP($J,"RADLQ",RADIV))
I RA3 N RA1,RA4 S RA1=$P($G(^DIC(4,RA3,0)),"^") D
. S RA4=$O(^TMP($J,"RADLQ",RA3,"")) S:RA4]"" RA2=RA4
. S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR
. Q
Q
IMGCHK ; Output statistics within Imaging Type
N RA5
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR Q:RAXIT
W !!?RATAB(6),"Imaging Type Total '"_RA2_"': "
W +$G(^TMP($J,"RADLQ",RADIV,RA2))
S RA5=$O(^TMP($J,"RADLQ",RADIV,RAITYPE))
I RA5]"" S RA2=RA5 D
. N RA1 S RA1=$P($G(^DIC(4,RADIV,0)),"^")
. S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRADLQ2 3905 printed Apr 09, 2024@21:41:58 Page 2
RADLQ2 ;HISC/GJC-Delq Status/Incomplete Rpt's ;3/6/97 08:50
+1 ;;5.0;Radiology/Nuclear Medicine;**15,47**;Mar 16, 1998;Build 21
DATE ; Sort by date
+1 SET RADIV=""
FOR
SET RADIV=$ORDER(^TMP($JOB,"RADLQ",RADIV))
if RADIV']""
QUIT
Begin DoDot:1
+2 SET RA1=$PIECE($GET(^DIC(4,RADIV,0)),"^")
SET RAITYPE=""
+3 FOR
SET RAITYPE=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE))
if RAITYPE']""
QUIT
Begin DoDot:2
+4 SET RA2=RAITYPE
SET RAVAR=""
+5 FOR
SET RAVAR=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR))
if RAVAR']""
QUIT
Begin DoDot:3
+6 SET RADTE=0
+7 FOR
SET RADTE=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE))
if RADTE'>0
QUIT
Begin DoDot:4
+8 SET RANME=""
+9 FOR
SET RANME=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE,RANME))
if RANME']""
QUIT
Begin DoDot:5
+10 SET RACN=0
+11 FOR
SET RACN=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE,RANME,RACN))
if RACN'>0
QUIT
Begin DoDot:6
+12 SET RANODE=$GET(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RADTE,RANME,RACN))
+13 if RANODE]""
DO OUTPUT^RADLQ3
+14 QUIT
End DoDot:6
if RAXIT
QUIT
+15 QUIT
End DoDot:5
if RAXIT
QUIT
+16 QUIT
End DoDot:4
if RAXIT
QUIT
+17 QUIT
End DoDot:3
if RAXIT
QUIT
+18 if 'RAXIT
DO IMGCHK
+19 QUIT
End DoDot:2
if RAXIT
QUIT
+20 if 'RAXIT
DO DIVCHK
+21 QUIT
End DoDot:1
if RAXIT
QUIT
+22 QUIT
HDR ; Header for reports
+1 IF RAPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+2 SET RAPG=RAPG+1
WRITE !?(IOM-$LENGTH(RAHD(0))\2),RAHD(0)
+3 WRITE !,"Division: ",$SELECT($DATA(RAFLAG):"",1:RA1),?RATAB("HEAD"),"Page: ",RAPG
+4 WRITE !,"Imaging Type: ",$SELECT($DATA(RAFLAG):"",1:RA2),?RATAB("HEAD"),"Date: "
+5 WRITE $$FMTE^XLFDT($$DT^XLFDT,1)
+6 WRITE !,RALN2
+7 IF $$USESSAN^RAHLRU1()
WRITE !,"Patient Name",?RATAB(1),"Case #",?RATAB(2)+6,"Pt ID"
+8 IF '$$USESSAN^RAHLRU1()
WRITE !,"Patient Name",?RATAB(1),"Case #",?RATAB(2),"Pt ID"
+9 WRITE ?RATAB(3),"Date",?RATAB(4),"Ward/Clinic"
+10 WRITE ?RATAB(5),"Rpt Stat",!?RATAB(6),"Procedure"
+11 WRITE ?RATAB(7),"Exam Status",?RATAB(8),"Rpt Text"
+12 WRITE ?RATAB(9),"Interp. Phys.",?RATAB(10),"Tech",!,RALN2
+13 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
+14 QUIT
PATIENT ; Sort by patient
+1 SET RADIV=""
FOR
SET RADIV=$ORDER(^TMP($JOB,"RADLQ",RADIV))
if RADIV']""
QUIT
Begin DoDot:1
+2 SET RA1=$PIECE($GET(^DIC(4,RADIV,0)),"^")
SET RAITYPE=""
+3 FOR
SET RAITYPE=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE))
if RAITYPE']""
QUIT
Begin DoDot:2
+4 SET RA2=RAITYPE
SET RAVAR=""
+5 FOR
SET RAVAR=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR))
if RAVAR']""
QUIT
Begin DoDot:3
+6 SET RANME=""
+7 FOR
SET RANME=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RANME))
if RANME']""
QUIT
Begin DoDot:4
+8 SET RADTE=0
+9 FOR
SET RADTE=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RANME,RADTE))
if RADTE'>0
QUIT
Begin DoDot:5
+10 SET RACN=0
+11 FOR
SET RACN=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RANME,RADTE,RACN))
if RACN'>0
QUIT
Begin DoDot:6
+12 SET RANODE=$GET(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,RANME,RADTE,RACN))
+13 if RANODE]""
DO OUTPUT^RADLQ3
+14 QUIT
End DoDot:6
if RAXIT
QUIT
+15 QUIT
End DoDot:5
if RAXIT
QUIT
+16 QUIT
End DoDot:4
if RAXIT
QUIT
+17 QUIT
End DoDot:3
if RAXIT
QUIT
+18 if 'RAXIT
DO IMGCHK
+19 QUIT
End DoDot:2
if RAXIT
QUIT
+20 if 'RAXIT
DO DIVCHK
+21 QUIT
End DoDot:1
if RAXIT
QUIT
+22 QUIT
PRINT ; Outputting the data
+1 SET RATAB(1)=$SELECT(IOM=132:40,1:22)
SET RATAB(2)=$SELECT(IOM=132:54,1:32)
+2 SET RATAB(3)=$SELECT(IOM=132:74,1:45)
SET RATAB(4)=$SELECT(IOM=132:90,1:55)
+3 ; for 132 & 80 column
SET RATAB(5)=$SELECT(IOM=132:120,1:72)
SET RATAB(6)=1
+4 SET RATAB(7)=$SELECT(IOM=132:40,1:23)
SET RATAB(8)=$SELECT(IOM=132:75,1:36)
+5 SET RATAB(9)=$SELECT(IOM=132:90,1:46)
SET RATAB(10)=$SELECT(IOM=132:114,1:63)
+6 SET RATAB("HEAD")=$SELECT(IOM=132:102,1:62)
+7 SET RADIV=$ORDER(^TMP($JOB,"RADLQ",""))
SET RA2=$ORDER(^TMP($JOB,"RADLQ",RADIV,""))
+8 SET RA1=$PIECE($GET(^DIC(4,RADIV,0)),"^")
DO HDR
+9 DO @$SELECT(RASORT2="P":"PATIENT",1:"DATE")
+10 QUIT
DIVCHK ; Output statistics within division
+1 NEW RA3
IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HDR
if RAXIT
QUIT
+2 WRITE !!?RATAB(6),"Division Total '"_RA1_"': ",+$GET(^TMP($JOB,"RADLQ",RADIV))
+3 SET RA3=+$ORDER(^TMP($JOB,"RADLQ",RADIV))
+4 IF RA3
NEW RA1,RA4
SET RA1=$PIECE($GET(^DIC(4,RA3,0)),"^")
Begin DoDot:1
+5 SET RA4=$ORDER(^TMP($JOB,"RADLQ",RA3,""))
if RA4]""
SET RA2=RA4
+6 if $EXTRACT(IOST,1,2)="C-"
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HDR
+7 QUIT
End DoDot:1
+8 QUIT
IMGCHK ; Output statistics within Imaging Type
+1 NEW RA5
+2 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HDR
if RAXIT
QUIT
+3 WRITE !!?RATAB(6),"Imaging Type Total '"_RA2_"': "
+4 WRITE +$GET(^TMP($JOB,"RADLQ",RADIV,RA2))
+5 SET RA5=$ORDER(^TMP($JOB,"RADLQ",RADIV,RAITYPE))
+6 IF RA5]""
SET RA2=RA5
Begin DoDot:1
+7 NEW RA1
SET RA1=$PIECE($GET(^DIC(4,RADIV,0)),"^")
+8 if $EXTRACT(IOST,1,2)="C-"
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HDR
+9 QUIT
End DoDot:1
+10 QUIT
