- 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 Feb 19, 2025@00:01:01 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