RATRAN ;HISC/FPT AISC/DMK-Transcriptionist Report ;8/14/97 11:08
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
K ^TMP($J) S RATITLE="Transcriptionist",RAOUT=0
W !!?10,">>> IMAGING TRANSCRIPTIONIST WORKLOAD REPORT <<<",!
I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
I $O(RACCESS(DUZ,""))="" D ACCVIO^RAUTL19 Q
D SELDIV^RAUTL7
I '$D(^TMP($J,"RA D-TYPE"))!($G(RAQUIT)) D END Q
S A="" F S A=$O(^TMP($J,"RA D-TYPE",A)) Q:A="" S ^TMP($J,"RATWKL",A)=""
S RASW=$$ALLNOTH^RALWKL3()
I RASW="" D END Q
I RASW=0 D USER I '$D(^TMP($J,"RATRAN")) D END Q
I RASW=0 S RAFLDCNT=0,RALP="" F S RALP=$O(^TMP($J,"RATRAN",RALP)) Q:RALP="" S RALP1="" F S RALP1=$O(^TMP($J,"RATRAN",RALP,RALP1)) Q:RALP1'>0 S RAFLDCNT=RAFLDCNT+1
K RALP,RALP1
D DATE^RAUTL I RAPOP D END Q
S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999
S ZTRTN="START^RATRAN",ZTDESC="Rad/Nuc Med TRANSCRIPT RPT",ZTSAVE("^TMP($J,""RATWKL"",")="",ZTSAVE("^TMP($J,""RATRAN"",")=""
F RASV="RABEG","RAEND","RAFLDCNT","RASW" S ZTSAVE(RASV)=""
D ZIS^RAUTL G END:RAPOP
;
START ; start processing
U IO S:$D(ZTQUEUED) ZTREQ="@"
S QQ="",$P(QQ,"=",80)="=",(LCNT,RAOUT,RAPG)=0
S Y=RABEG+.0001 D D^RAUTL S RASTART=Y,Y=RAEND-.9999 D D^RAUTL S RAFINISH=Y
; all transcriptionists
I RASW=1 S RADUZ=0 D
.F S RADUZ=$O(^RARPT("AD",RADUZ)) Q:RADUZ'>0 D Q:RAOUT
..F I=RABEG:0 S I=$O(^RARPT("AD",RADUZ,I)) Q:I'>0!(I>RAEND) D Q:RAOUT
...F J=0:0 S J=$O(^RARPT("AD",RADUZ,I,J)) Q:J'>0!(RAOUT) I $D(^RARPT(J,0)),$D(^("T")) D SET
...Q
..Q
.Q
; selected transcriptionists
I 'RASW S RATRAN="" D
.F S RATRAN=$O(^TMP($J,"RATRAN",RATRAN)) Q:RATRAN="" S RADUZ=0 D Q:RAOUT
..F S RADUZ=$O(^TMP($J,"RATRAN",RATRAN,RADUZ)) Q:RADUZ'>0 I $D(^RARPT("AD",RADUZ)) D Q:RAOUT
...F I=RABEG:0 S I=$O(^RARPT("AD",RADUZ,I)) Q:I'>0!(I>RAEND) D Q:RAOUT
....F J=0:0 S J=$O(^RARPT("AD",RADUZ,I,J)) Q:J'>0!(RAOUT) I $D(^RARPT(J,0)),$D(^("T")) D SET
....Q
...Q
..Q
.Q
;
GET ; get tmp global values
S RADIV=""
F S RADIV=$O(^TMP($J,"RATWKL",RADIV)) Q:RAOUT!(RADIV="") D HDR Q:RAOUT D:+^TMP($J,"RATWKL",RADIV)=0 NEGRPT S I="" F S I=$O(^TMP($J,"RADUZ",RADIV,I)) Q:RAOUT!(I="") D D:'RAOUT WRT
.S RACNT=$P(^(I),"^"),RANAME=$P(I,"/",1),RATCNT=$P(^(I),"^",2)
;
END ; kill variables, close device
K A,BEGDATE,ENDDATE,I,J,LCNT,QQ,RABEG,RACNT,RADFN,RADIV,RADIVNME,RADTI,RADUZ,RADUZNME,RAEND,RAFINISH,RAFLDCNT,RAI
K RANAME,RAOUT,RAPG,RAPGM,RAPOP,RAQUIT,RARPTNDE,RASKIP,RASTART,RASV,RASW,RATCNT,RATITLE,RATRAN,X,Y,^TMP($J)
K:$D(RAPSTX) RACCESS,RAPSTX
D CLOSE^RAUTL
K A,DIRUT,DUOUT,I,POP,RAMES,RAOUT,RAPOP,RAPSTX,RAQUIT,RASW,RATITLE,ZTDESC,ZTRTN,ZTSAVE
Q
SET ; set tmp global
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
S RADUZNME=$P($G(^VA(200,RADUZ,0)),U,1)
I RADUZNME="" Q
S RARPTNDE=$G(^RARPT(J,0)),RADFN=+$P(RARPTNDE,U,2),RADTI=9999999.9999-$P(RARPTNDE,U,3),RADTI=+RADTI
I '$D(^RADPT(+RADFN,"DT",RADTI)) Q
S RADIV=$P($G(^RADPT(+RADFN,"DT",RADTI,0)),U,3),RADIV=$P($G(^RA(79,+RADIV,0)),U,1),RADIVNME=$P($G(^DIC(4,+RADIV,0)),U,1)
I RADIVNME="" Q
I '$D(^TMP($J,"RATWKL",RADIVNME)) Q
I 'RASW,'$D(^TMP($J,"RATRAN",RADUZNME,RADUZ)) Q
S LCNT=+$$LCNT(J)
S RADUZNME=RADUZNME_"/"_RADUZ
I '$D(^TMP($J,"RADUZ",RADIVNME,RADUZNME)) S ^(RADUZNME)="0^0"
S RADUZ(0)=^TMP($J,"RADUZ",RADIVNME,RADUZNME)
S $P(RADUZ(0),"^")=$P(RADUZ(0),"^")+LCNT
S $P(RADUZ(0),"^",2)=$P(RADUZ(0),"^",2)+1
S ^TMP($J,"RADUZ",RADIVNME,RADUZNME)=RADUZ(0),^TMP($J,"RATWKL",RADIVNME)=^TMP($J,"RATWKL",RADIVNME)+1
K RADUZ(0)
Q
LCNT(J) ; Count lines in report text and impression text. If the number of
; characters in either the report or impression text add up to a number
; greater than zero and less than seventy five, assume that we have
; seventy five characters.
N K,LCNT S (LCNT,LCNT("I"),LCNT("R"))=0
I $D(^RARPT(J,"I")) S K=0 F S K=$O(^RARPT(J,"I",K)) Q:K="" S LCNT("I")=$L(^RARPT(J,"I",K,0))+LCNT("I") ; count impression text chars
S:LCNT("I")&(LCNT("I")<75) LCNT("I")=75
I $D(^RARPT(J,"R")) S K=0 F S K=$O(^RARPT(J,"R",K)) Q:K="" S LCNT("R")=$L(^RARPT(J,"R",K,0))+LCNT("R") ; count report text characters
S:LCNT("R")&(LCNT("R")<75) LCNT("R")=75
; the total number of lines equal the number of impression text chars
; plus the number of report text chars divided by seventy five.
S LCNT=LCNT("I")+LCNT("R")
S LCNT=$J(LCNT/75,0,0)
Q LCNT
WRT ; write out counts
I ($Y+4)>IOSL S RAOUT=$$EOS^RAUTL5() Q:RAOUT D:$O(^TMP($J,"RADUZ",RADIV,I))]"" HDR Q:RAOUT
W !,RANAME,?50,RACNT,?67,RATCNT
I $O(^TMP($J,"RATWKL",RADIV))]"",$O(^TMP($J,"RADUZ",RADIV,I))="" S RAOUT=$$EOS^RAUTL5
Q
HDR ; header
W:$Y>0 @IOF,!?21,">>> IMAGING TRANSCRIPTION REPORT <<<" S RAPG=RAPG+1 W ?70,"PAGE: ",RAPG
W !?23,"Division: ",RADIV
W !?21,"Date Range: ",RASTART," - ",RAFINISH
W !,"# of Transcriptionists selected: ",$S($G(RAFLDCNT)>0:$G(RAFLDCNT),1:"ALL"),!
W !,"RADIOLOGY/NUCLEAR MEDICINE PERSONNEL",?44,"NUMBER OF LINES",?61,"NUMBER OF REPORTS"
W !,QQ,!
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1
Q
USER ; select transcriptionists to appear in report
S RADIC="^VA(200,",RADIC(0)="AEMQZ",RADIC("A")="Select "_RATITLE_": ",RADIC("S")="I $D(^VA(200,+Y,""RAC"")),$D(^RARPT(""AD"",+Y))",RAUTIL="RATRAN"
D EN1^RASELCT(.RADIC,RAUTIL,"",RASW)
K RADIC,RAUTIL
Q
NEGRPT ; negative report message
W !!,"In this division there were no reports found for the transcriptionists selected."
I $O(^TMP($J,"RATWKL",RADIV))]"" S RAOUT=$$EOS^RAUTL5()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRATRAN 5530 printed Dec 13, 2024@02:40:05 Page 2
RATRAN ;HISC/FPT AISC/DMK-Transcriptionist Report ;8/14/97 11:08
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ;
+3 KILL ^TMP($JOB)
SET RATITLE="Transcriptionist"
SET RAOUT=0
+4 WRITE !!?10,">>> IMAGING TRANSCRIPTIONIST WORKLOAD REPORT <<<",!
+5 IF $ORDER(RACCESS(DUZ,""))=""
DO SETVARS^RAPSET1(0)
SET RAPSTX=""
+6 IF $ORDER(RACCESS(DUZ,""))=""
DO ACCVIO^RAUTL19
QUIT
+7 DO SELDIV^RAUTL7
+8 IF '$DATA(^TMP($JOB,"RA D-TYPE"))!($GET(RAQUIT))
DO END
QUIT
+9 SET A=""
FOR
SET A=$ORDER(^TMP($JOB,"RA D-TYPE",A))
if A=""
QUIT
SET ^TMP($JOB,"RATWKL",A)=""
+10 SET RASW=$$ALLNOTH^RALWKL3()
+11 IF RASW=""
DO END
QUIT
+12 IF RASW=0
DO USER
IF '$DATA(^TMP($JOB,"RATRAN"))
DO END
QUIT
+13 IF RASW=0
SET RAFLDCNT=0
SET RALP=""
FOR
SET RALP=$ORDER(^TMP($JOB,"RATRAN",RALP))
if RALP=""
QUIT
SET RALP1=""
FOR
SET RALP1=$ORDER(^TMP($JOB,"RATRAN",RALP,RALP1))
if RALP1'>0
QUIT
SET RAFLDCNT=RAFLDCNT+1
+14 KILL RALP,RALP1
+15 DO DATE^RAUTL
IF RAPOP
DO END
QUIT
+16 SET RABEG=BEGDATE-.0001
SET RAEND=ENDDATE+.9999
+17 SET ZTRTN="START^RATRAN"
SET ZTDESC="Rad/Nuc Med TRANSCRIPT RPT"
SET ZTSAVE("^TMP($J,""RATWKL"",")=""
SET ZTSAVE("^TMP($J,""RATRAN"",")=""
+18 FOR RASV="RABEG","RAEND","RAFLDCNT","RASW"
SET ZTSAVE(RASV)=""
+19 DO ZIS^RAUTL
if RAPOP
GOTO END
+20 ;
START ; start processing
+1 USE IO
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 SET QQ=""
SET $PIECE(QQ,"=",80)="="
SET (LCNT,RAOUT,RAPG)=0
+3 SET Y=RABEG+.0001
DO D^RAUTL
SET RASTART=Y
SET Y=RAEND-.9999
DO D^RAUTL
SET RAFINISH=Y
+4 ; all transcriptionists
+5 IF RASW=1
SET RADUZ=0
Begin DoDot:1
+6 FOR
SET RADUZ=$ORDER(^RARPT("AD",RADUZ))
if RADUZ'>0
QUIT
Begin DoDot:2
+7 FOR I=RABEG:0
SET I=$ORDER(^RARPT("AD",RADUZ,I))
if I'>0!(I>RAEND)
QUIT
Begin DoDot:3
+8 FOR J=0:0
SET J=$ORDER(^RARPT("AD",RADUZ,I,J))
if J'>0!(RAOUT)
QUIT
IF $DATA(^RARPT(J,0))
IF $DATA(^("T"))
DO SET
+9 QUIT
End DoDot:3
if RAOUT
QUIT
+10 QUIT
End DoDot:2
if RAOUT
QUIT
+11 QUIT
End DoDot:1
+12 ; selected transcriptionists
+13 IF 'RASW
SET RATRAN=""
Begin DoDot:1
+14 FOR
SET RATRAN=$ORDER(^TMP($JOB,"RATRAN",RATRAN))
if RATRAN=""
QUIT
SET RADUZ=0
Begin DoDot:2
+15 FOR
SET RADUZ=$ORDER(^TMP($JOB,"RATRAN",RATRAN,RADUZ))
if RADUZ'>0
QUIT
IF $DATA(^RARPT("AD",RADUZ))
Begin DoDot:3
+16 FOR I=RABEG:0
SET I=$ORDER(^RARPT("AD",RADUZ,I))
if I'>0!(I>RAEND)
QUIT
Begin DoDot:4
+17 FOR J=0:0
SET J=$ORDER(^RARPT("AD",RADUZ,I,J))
if J'>0!(RAOUT)
QUIT
IF $DATA(^RARPT(J,0))
IF $DATA(^("T"))
DO SET
+18 QUIT
End DoDot:4
if RAOUT
QUIT
+19 QUIT
End DoDot:3
if RAOUT
QUIT
+20 QUIT
End DoDot:2
if RAOUT
QUIT
+21 QUIT
End DoDot:1
+22 ;
GET ; get tmp global values
+1 SET RADIV=""
+2 FOR
SET RADIV=$ORDER(^TMP($JOB,"RATWKL",RADIV))
if RAOUT!(RADIV="")
QUIT
DO HDR
if RAOUT
QUIT
if +^TMP($JOB,"RATWKL",RADIV)=0
DO NEGRPT
SET I=""
FOR
SET I=$ORDER(^TMP($JOB,"RADUZ",RADIV,I))
if RAOUT!(I="")
QUIT
Begin DoDot:1
+3 SET RACNT=$PIECE(^(I),"^")
SET RANAME=$PIECE(I,"/",1)
SET RATCNT=$PIECE(^(I),"^",2)
End DoDot:1
if 'RAOUT
DO WRT
+4 ;
END ; kill variables, close device
+1 KILL A,BEGDATE,ENDDATE,I,J,LCNT,QQ,RABEG,RACNT,RADFN,RADIV,RADIVNME,RADTI,RADUZ,RADUZNME,RAEND,RAFINISH,RAFLDCNT,RAI
+2 KILL RANAME,RAOUT,RAPG,RAPGM,RAPOP,RAQUIT,RARPTNDE,RASKIP,RASTART,RASV,RASW,RATCNT,RATITLE,RATRAN,X,Y,^TMP($JOB)
+3 if $DATA(RAPSTX)
KILL RACCESS,RAPSTX
+4 DO CLOSE^RAUTL
+5 KILL A,DIRUT,DUOUT,I,POP,RAMES,RAOUT,RAPOP,RAPSTX,RAQUIT,RASW,RATITLE,ZTDESC,ZTRTN,ZTSAVE
+6 QUIT
SET ; set tmp global
+1 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAOUT=1
if RAOUT
QUIT
+2 SET RADUZNME=$PIECE($GET(^VA(200,RADUZ,0)),U,1)
+3 IF RADUZNME=""
QUIT
+4 SET RARPTNDE=$GET(^RARPT(J,0))
SET RADFN=+$PIECE(RARPTNDE,U,2)
SET RADTI=9999999.9999-$PIECE(RARPTNDE,U,3)
SET RADTI=+RADTI
+5 IF '$DATA(^RADPT(+RADFN,"DT",RADTI))
QUIT
+6 SET RADIV=$PIECE($GET(^RADPT(+RADFN,"DT",RADTI,0)),U,3)
SET RADIV=$PIECE($GET(^RA(79,+RADIV,0)),U,1)
SET RADIVNME=$PIECE($GET(^DIC(4,+RADIV,0)),U,1)
+7 IF RADIVNME=""
QUIT
+8 IF '$DATA(^TMP($JOB,"RATWKL",RADIVNME))
QUIT
+9 IF 'RASW
IF '$DATA(^TMP($JOB,"RATRAN",RADUZNME,RADUZ))
QUIT
+10 SET LCNT=+$$LCNT(J)
+11 SET RADUZNME=RADUZNME_"/"_RADUZ
+12 IF '$DATA(^TMP($JOB,"RADUZ",RADIVNME,RADUZNME))
SET ^(RADUZNME)="0^0"
+13 SET RADUZ(0)=^TMP($JOB,"RADUZ",RADIVNME,RADUZNME)
+14 SET $PIECE(RADUZ(0),"^")=$PIECE(RADUZ(0),"^")+LCNT
+15 SET $PIECE(RADUZ(0),"^",2)=$PIECE(RADUZ(0),"^",2)+1
+16 SET ^TMP($JOB,"RADUZ",RADIVNME,RADUZNME)=RADUZ(0)
SET ^TMP($JOB,"RATWKL",RADIVNME)=^TMP($JOB,"RATWKL",RADIVNME)+1
+17 KILL RADUZ(0)
+18 QUIT
LCNT(J) ; Count lines in report text and impression text. If the number of
+1 ; characters in either the report or impression text add up to a number
+2 ; greater than zero and less than seventy five, assume that we have
+3 ; seventy five characters.
+4 NEW K,LCNT
SET (LCNT,LCNT("I"),LCNT("R"))=0
+5 ; count impression text chars
IF $DATA(^RARPT(J,"I"))
SET K=0
FOR
SET K=$ORDER(^RARPT(J,"I",K))
if K=""
QUIT
SET LCNT("I")=$LENGTH(^RARPT(J,"I",K,0))+LCNT("I")
+6 if LCNT("I")&(LCNT("I")<75)
SET LCNT("I")=75
+7 ; count report text characters
IF $DATA(^RARPT(J,"R"))
SET K=0
FOR
SET K=$ORDER(^RARPT(J,"R",K))
if K=""
QUIT
SET LCNT("R")=$LENGTH(^RARPT(J,"R",K,0))+LCNT("R")
+8 if LCNT("R")&(LCNT("R")<75)
SET LCNT("R")=75
+9 ; the total number of lines equal the number of impression text chars
+10 ; plus the number of report text chars divided by seventy five.
+11 SET LCNT=LCNT("I")+LCNT("R")
+12 SET LCNT=$JUSTIFY(LCNT/75,0,0)
+13 QUIT LCNT
WRT ; write out counts
+1 IF ($Y+4)>IOSL
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
if $ORDER(^TMP($JOB,"RADUZ",RADIV,I))]""
DO HDR
if RAOUT
QUIT
+2 WRITE !,RANAME,?50,RACNT,?67,RATCNT
+3 IF $ORDER(^TMP($JOB,"RATWKL",RADIV))]""
IF $ORDER(^TMP($JOB,"RADUZ",RADIV,I))=""
SET RAOUT=$$EOS^RAUTL5
+4 QUIT
HDR ; header
+1 if $Y>0
WRITE @IOF,!?21,">>> IMAGING TRANSCRIPTION REPORT <<<"
SET RAPG=RAPG+1
WRITE ?70,"PAGE: ",RAPG
+2 WRITE !?23,"Division: ",RADIV
+3 WRITE !?21,"Date Range: ",RASTART," - ",RAFINISH
+4 WRITE !,"# of Transcriptionists selected: ",$SELECT($GET(RAFLDCNT)>0:$GET(RAFLDCNT),1:"ALL"),!
+5 WRITE !,"RADIOLOGY/NUCLEAR MEDICINE PERSONNEL",?44,"NUMBER OF LINES",?61,"NUMBER OF REPORTS"
+6 WRITE !,QQ,!
+7 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAOUT=1
+8 QUIT
USER ; select transcriptionists to appear in report
+1 SET RADIC="^VA(200,"
SET RADIC(0)="AEMQZ"
SET RADIC("A")="Select "_RATITLE_": "
SET RADIC("S")="I $D(^VA(200,+Y,""RAC"")),$D(^RARPT(""AD"",+Y))"
SET RAUTIL="RATRAN"
+2 DO EN1^RASELCT(.RADIC,RAUTIL,"",RASW)
+3 KILL RADIC,RAUTIL
+4 QUIT
NEGRPT ; negative report message
+1 WRITE !!,"In this division there were no reports found for the transcriptionists selected."
+2 IF $ORDER(^TMP($JOB,"RATWKL",RADIV))]""
SET RAOUT=$$EOS^RAUTL5()
+3 QUIT
