source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RATRAN.m@ 1429

Last change on this file since 1429 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.3 KB
Line 
1RATRAN ;HISC/FPT AISC/DMK-Transcriptionist Report ;8/14/97 11:08
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4 K ^TMP($J) S RATITLE="Transcriptionist",RAOUT=0
5 W !!?10,">>> IMAGING TRANSCRIPTIONIST WORKLOAD REPORT <<<",!
6 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
7 I $O(RACCESS(DUZ,""))="" D ACCVIO^RAUTL19 Q
8 D SELDIV^RAUTL7
9 I '$D(^TMP($J,"RA D-TYPE"))!($G(RAQUIT)) D END Q
10 S A="" F S A=$O(^TMP($J,"RA D-TYPE",A)) Q:A="" S ^TMP($J,"RATWKL",A)=""
11 S RASW=$$ALLNOTH^RALWKL3()
12 I RASW="" D END Q
13 I RASW=0 D USER I '$D(^TMP($J,"RATRAN")) D END Q
14 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
15 K RALP,RALP1
16 D DATE^RAUTL I RAPOP D END Q
17 S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999
18 S ZTRTN="START^RATRAN",ZTDESC="Rad/Nuc Med TRANSCRIPT RPT",ZTSAVE("^TMP($J,""RATWKL"",")="",ZTSAVE("^TMP($J,""RATRAN"",")=""
19 F RASV="RABEG","RAEND","RAFLDCNT","RASW" S ZTSAVE(RASV)=""
20 D ZIS^RAUTL G END:RAPOP
21 ;
22START ; start processing
23 U IO S:$D(ZTQUEUED) ZTREQ="@"
24 S QQ="",$P(QQ,"=",80)="=",(LCNT,RAOUT,RAPG)=0
25 S Y=RABEG+.0001 D D^RAUTL S RASTART=Y,Y=RAEND-.9999 D D^RAUTL S RAFINISH=Y
26 ; all transcriptionists
27 I RASW=1 S RADUZ=0 D
28 .F S RADUZ=$O(^RARPT("AD",RADUZ)) Q:RADUZ'>0 D Q:RAOUT
29 ..F I=RABEG:0 S I=$O(^RARPT("AD",RADUZ,I)) Q:I'>0!(I>RAEND) D Q:RAOUT
30 ...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
31 ...Q
32 ..Q
33 .Q
34 ; selected transcriptionists
35 I 'RASW S RATRAN="" D
36 .F S RATRAN=$O(^TMP($J,"RATRAN",RATRAN)) Q:RATRAN="" S RADUZ=0 D Q:RAOUT
37 ..F S RADUZ=$O(^TMP($J,"RATRAN",RATRAN,RADUZ)) Q:RADUZ'>0 I $D(^RARPT("AD",RADUZ)) D Q:RAOUT
38 ...F I=RABEG:0 S I=$O(^RARPT("AD",RADUZ,I)) Q:I'>0!(I>RAEND) D Q:RAOUT
39 ....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
40 ....Q
41 ...Q
42 ..Q
43 .Q
44 ;
45GET ; get tmp global values
46 S RADIV=""
47 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
48 .S RACNT=$P(^(I),"^"),RANAME=$P(I,"/",1),RATCNT=$P(^(I),"^",2)
49 ;
50END ; kill variables, close device
51 K A,BEGDATE,ENDDATE,I,J,LCNT,QQ,RABEG,RACNT,RADFN,RADIV,RADIVNME,RADTI,RADUZ,RADUZNME,RAEND,RAFINISH,RAFLDCNT,RAI
52 K RANAME,RAOUT,RAPG,RAPGM,RAPOP,RAQUIT,RARPTNDE,RASKIP,RASTART,RASV,RASW,RATCNT,RATITLE,RATRAN,X,Y,^TMP($J)
53 K:$D(RAPSTX) RACCESS,RAPSTX
54 D CLOSE^RAUTL
55 K A,DIRUT,DUOUT,I,POP,RAMES,RAOUT,RAPOP,RAPSTX,RAQUIT,RASW,RATITLE,ZTDESC,ZTRTN,ZTSAVE
56 Q
57SET ; set tmp global
58 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
59 S RADUZNME=$P($G(^VA(200,RADUZ,0)),U,1)
60 I RADUZNME="" Q
61 S RARPTNDE=$G(^RARPT(J,0)),RADFN=+$P(RARPTNDE,U,2),RADTI=9999999.9999-$P(RARPTNDE,U,3),RADTI=+RADTI
62 I '$D(^RADPT(+RADFN,"DT",RADTI)) Q
63 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)
64 I RADIVNME="" Q
65 I '$D(^TMP($J,"RATWKL",RADIVNME)) Q
66 I 'RASW,'$D(^TMP($J,"RATRAN",RADUZNME,RADUZ)) Q
67 S LCNT=+$$LCNT(J)
68 S RADUZNME=RADUZNME_"/"_RADUZ
69 I '$D(^TMP($J,"RADUZ",RADIVNME,RADUZNME)) S ^(RADUZNME)="0^0"
70 S RADUZ(0)=^TMP($J,"RADUZ",RADIVNME,RADUZNME)
71 S $P(RADUZ(0),"^")=$P(RADUZ(0),"^")+LCNT
72 S $P(RADUZ(0),"^",2)=$P(RADUZ(0),"^",2)+1
73 S ^TMP($J,"RADUZ",RADIVNME,RADUZNME)=RADUZ(0),^TMP($J,"RATWKL",RADIVNME)=^TMP($J,"RATWKL",RADIVNME)+1
74 K RADUZ(0)
75 Q
76LCNT(J) ; Count lines in report text and impression text. If the number of
77 ; characters in either the report or impression text add up to a number
78 ; greater than zero and less than seventy five, assume that we have
79 ; seventy five characters.
80 N K,LCNT S (LCNT,LCNT("I"),LCNT("R"))=0
81 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
82 S:LCNT("I")&(LCNT("I")<75) LCNT("I")=75
83 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
84 S:LCNT("R")&(LCNT("R")<75) LCNT("R")=75
85 ; the total number of lines equal the number of impression text chars
86 ; plus the number of report text chars divided by seventy five.
87 S LCNT=LCNT("I")+LCNT("R")
88 S LCNT=$J(LCNT/75,0,0)
89 Q LCNT
90WRT ; write out counts
91 I ($Y+4)>IOSL S RAOUT=$$EOS^RAUTL5() Q:RAOUT D:$O(^TMP($J,"RADUZ",RADIV,I))]"" HDR Q:RAOUT
92 W !,RANAME,?50,RACNT,?67,RATCNT
93 I $O(^TMP($J,"RATWKL",RADIV))]"",$O(^TMP($J,"RADUZ",RADIV,I))="" S RAOUT=$$EOS^RAUTL5
94 Q
95HDR ; header
96 W:$Y>0 @IOF,!?21,">>> IMAGING TRANSCRIPTION REPORT <<<" S RAPG=RAPG+1 W ?70,"PAGE: ",RAPG
97 W !?23,"Division: ",RADIV
98 W !?21,"Date Range: ",RASTART," - ",RAFINISH
99 W !,"# of Transcriptionists selected: ",$S($G(RAFLDCNT)>0:$G(RAFLDCNT),1:"ALL"),!
100 W !,"RADIOLOGY/NUCLEAR MEDICINE PERSONNEL",?44,"NUMBER OF LINES",?61,"NUMBER OF REPORTS"
101 W !,QQ,!
102 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1
103 Q
104USER ; select transcriptionists to appear in report
105 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"
106 D EN1^RASELCT(.RADIC,RAUTIL,"",RASW)
107 K RADIC,RAUTIL
108 Q
109NEGRPT ; negative report message
110 W !!,"In this division there were no reports found for the transcriptionists selected."
111 I $O(^TMP($J,"RATWKL",RADIV))]"" S RAOUT=$$EOS^RAUTL5()
112 Q
Note: See TracBrowser for help on using the repository browser.