source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAESR1.m@ 1093

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1RAESR1 ;HISC/GJC-Exam Statistics Rpt ;1/20/95 09:36
2 ;;5.0;Radiology/Nuclear Medicine;**48**;Mar 16, 1998
3 S (RAPGE,RATOT,RAXIT)=0,RARUNDT=$$FMTE^XLFDT($$DT^XLFDT(),1)
4 S $P(RALINE,"-",78)=""
5 I '$D(^TMP($J,"RASTAT","RALOC")) D G PURGE^RAESR2
6 . W @IOF,!!?5,"No exams registered for time period "
7 . W BEGDTX_" to "_ENDDTX_".",!
8 . Q
9 D @RARPT
10 I 'RAXIT D
11 . D DIVSYN^RAESR2
12 . Q
13 D PURGE^RAESR2
14 Q
151 ; Print Location Statistics
16 S RADNM=$O(^TMP($J,"RASTAT","RALOC",""))
17 S RAINM=$O(^TMP($J,"RASTAT","RALOC",RADNM,""))
18 S RALNM=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,""))
19 S T1=1 D HD^RAESR3 S RADNM=""
20 F S RADNM=$O(^TMP($J,"RASTAT","RALOC",RADNM)) Q:RADNM="" D Q:RAXIT
21 . S RAINM=""
22 . F S RAINM=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM)) Q:RAINM="" D Q:RAXIT
23 .. S RALNM=""
24 .. F S RALNM=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM)) Q:RALNM="" D Q:RAXIT
25 ... S RADAT=0
26 ... F S RADAT=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT)) Q:'RADAT D Q:RAXIT
27 .... S RASTAT=$G(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT))
28 .... S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
29 .... Q
30 ... D LOCCHK^RAESR2 Q:RAXIT
31 ... Q
32 .. D IMGCHK^RAESR2 Q:RAXIT
33 .. Q
34 . D DIVCHK^RAESR2 Q:RAXIT
35 . Q
36 Q
372 ; Print Imaging Type Statistics
38 S RADNM=$O(^TMP($J,"RASTAT","RAIMG",""))
39 S RAINM=$O(^TMP($J,"RASTAT","RAIMG",RADNM,""))
40 S T1=2 D HD^RAESR3 S RADNM=""
41 F S RADNM=$O(^TMP($J,"RASTAT","RAIMG",RADNM)) Q:RADNM="" D Q:RAXIT
42 . S RAINM="" F S RAINM=$O(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM)) Q:RAINM="" D Q:RAXIT
43 .. S RADAT=0 F S RADAT=$O(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT)) Q:'RADAT D Q:RAXIT
44 ... S RASTAT=$G(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT))
45 ... S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
46 ... Q
47 .. D IMGCHK^RAESR2 Q:RAXIT
48 .. Q
49 . D DIVCHK^RAESR2 Q:RAXIT
50 . Q
51 Q
523 ; Print Division Statistics
53 S RADNM=$O(^TMP($J,"RASTAT","RADIV","")),T1=3 D HD^RAESR3 S RADNM=""
54 F S RADNM=$O(^TMP($J,"RASTAT","RADIV",RADNM)) Q:RADNM="" D Q:RAXIT
55 . S RADAT=0
56 . F S RADAT=$O(^TMP($J,"RASTAT","RADIV",RADNM,RADAT)) Q:'RADAT D Q:RAXIT
57 .. S RASTAT=$G(^TMP($J,"RASTAT","RADIV",RADNM,RADAT))
58 .. S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
59 .. Q
60 . I 'RAXIT D TOT^RAESR3 D
61 .. N RA1 S RA1=$O(^TMP($J,"RASTAT","RADIV",RADNM))
62 .. I RA1]"" N RADNM S RADNM=RA1,RAXIT=$$EOS^RAUTL5() D:'RAXIT HD^RAESR3
63 .. Q
64 . Q
65 Q
664 ; Print all Statistics
67 S RADAT=0,T1=4 D HD^RAESR3
68 F S RADAT=$O(^TMP($J,"RASTAT","RATOT",RADAT)) Q:'RADAT D Q:RAXIT
69 . S RASTAT=$G(^TMP($J,"RASTAT","RATOT",RADAT))
70 . S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
71 . Q
72 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
73 D TOT^RAESR3 ;Print total line
74 Q
Note: See TracBrowser for help on using the repository browser.