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