source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAESR.m@ 1240

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1RAESR ;HISC/GJC AISC/RMO-Exam Statistics Rpt ;1/20/95 09:03
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ; Zero out data globals!
4 S A="" F S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']"" D
5 . Q:'$D(^TMP($J,"RA D-TYPE",A))
6 . S ^TMP($J,"RASTAT","RADIV",A)=0,B=""
7 . F S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']"" D
8 .. Q:'$D(^TMP($J,"RA I-TYPE",B))
9 .. S ^TMP($J,"RASTAT","RAIMG",A,B)=0
10 .. Q
11 . Q
12 K RACCESS(DUZ,"DIV-IMG") S ZTRTN="START^RAESR"
13 F I="BEGDTX","ENDDTX","BEGDATE","ENDDATE","RARPT","RATMEFRM","^TMP($J,""RA D-TYPE"",","^TMP($J,""RA I-TYPE"",","^TMP($J,""RASTAT""," S ZTSAVE(I)=""
14 D DATE^RAUTL G:RAPOP PURGE^RAESR2
15 S BEGDTX=$$FMTE^XLFDT(BEGDATE,1),ENDDTX=$$FMTE^XLFDT(ENDDATE,1)
16 S RATMEFRM="For Period: "_BEGDTX_" to "_ENDDTX_"."
17DEV W ! D ZIS^RAUTL G:RAPOP PURGE^RAESR2
18START ; Set-up date variables for selected date range.
19 ; NOTE: RADTE is the exam reg date/time, and RADTI is the
20 ; internal date number
21 U IO S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999
22 S RACNB=6,RADU="C:CONTRACT;E:EMPLOYEE;I:INPATIENT;O:OUTPATIENT;R:RESEARCH;S:SHARING;"
23 F RADTE=RABEG:0 S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE!(RADTE>RAEND) S RADTI=9999999.9999-RADTE S RADAT=$P(RADTE,".") D RADFN
24 G ^RAESR1 ; generate report
25RADFN ; Set RADFN the internal file number in the patient file, and check if
26 ; an Exam was registered on the specified date, RADTE
27 ; if so set RADO to the value of the Exam Registration node(Visit) via
28 ; the naked reference
29 F RADFN=0:0 S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAD0=$G(^(0)) D RACNI
30 Q
31RACNI ; Set RACNI the internal file number for an exam, and check for all
32 ; examinations performed during this patient visit
33 ; ^(RACNI,0), if so, set RAP0 to the value of the Examination node via
34 ; the naked reference
35 S RALNM=$S('$D(^RA(79.1,+$P(RAD0,"^",4),0)):"Unknown",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"Unknown")
36 S RAINM=$S($D(^RA(79.2,+$P(RAD0,"^",2),0)):$P(^(0),"^"),1:"Unknown")
37 S RACMP=$O(^RA(72,"AA",RAINM,9,0)) Q:'RACMP
38 ; Quit if no completed status for I-Type name.
39 S RADNM=$S($D(^DIC(4,+$P(RAD0,"^",3),0)):$P(^(0),"^"),1:"Unknown")
40 Q:'$D(^TMP($J,"RA D-TYPE",RADNM))!('$D(^TMP($J,"RA I-TYPE",RAINM)))
41 K RAFLG F RACNI=0:0 K RATMP S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI I $D(^(RACNI,0)),$P(^(0),"^",4)'="" S RAP0=^(0),RACTE=$P(RAP0,"^",4) D SETGLO
42 Q
43SETGLO ; Location Statistics
44 S:'$D(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT)) ^(RADAT)="" S Y=^(RADAT) D STATS S ^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT)=Y
45 S:'($D(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM))#2) ^(RALNM)="" S Y=^(RALNM) D STATS S ^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM)=Y
46 ; Imaging Type statistics
47 S:'$D(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT)) ^(RADAT)="" S Y=^(RADAT) D STATS S ^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT)=Y
48 S:'($D(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM))#2) ^(RAINM)="" S Y=^(RAINM) D STATS S ^TMP($J,"RASTAT","RAIMG",RADNM,RAINM)=Y
49 ; Division Statistics
50 S:'$D(^TMP($J,"RASTAT","RADIV",RADNM,RADAT)) ^(RADAT)="" S Y=^(RADAT) D SET:$D(RATMP),STATS:'$D(RATMP) S ^TMP($J,"RASTAT","RADIV",RADNM,RADAT)=Y
51 S:'($D(^TMP($J,"RASTAT","RADIV",RADNM))#2) ^(RADNM)="" S Y=^(RADNM) D SET:$D(RATMP),STATS:'$D(RATMP) S ^TMP($J,"RASTAT","RADIV",RADNM)=Y
52 ; Total Statistics
53 S:'$D(^TMP($J,"RASTAT","RATOT",RADAT)) ^(RADAT)="" S Y=^(RADAT) D SET:$D(RATMP),STATS:'$D(RATMP) S ^TMP($J,"RASTAT","RATOT",RADAT)=Y
54 S:'($D(^TMP($J,"RASTAT","RATOT"))#2) ^("RATOT")="" S Y=^("RATOT") D SET:$D(RATMP),STATS:'$D(RATMP) S ^TMP($J,"RASTAT","RATOT")=Y
55 Q
56STATS ; Calculate statistics for # of Visits, # of Exams, # of complete
57 ; Exams and Category
58 S:'$D(RAFLG) RAFLG="",$P(RATMP,"^")=1 S $P(RATMP,"^",2)=1 S:$P(RAP0,"^",3)=RACMP $P(RATMP,"^",3)=1
59 ; set global ^TMP for statistics including category
60 F T=1:1 I RACTE=$E($P(RADU,";",T)) S $P(RATMP,"^",T+3)=1 Q
61 ;
62SET ; Set variable
63 F I=1:1:9 S $P(Y,"^",I)=$P(Y,"^",I)+$P(RATMP,"^",I)
64 Q
65ASK ; Entry point from RA DAISTATS (Examination Statistics) menu
66 K ^TMP($J,"RASTAT")
67 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
68 S DIR(0)="S^L:Location;I:Imaging Type;D:Division;T:Totals Only"
69 S DIR("A")="Enter Report Detail Needed",DIR("B")="Location"
70 S DIR("?",1)="Enter 'L' to obtain location, imaging type, division and total statistics"
71 S DIR("?",2)="Enter 'I' to obtain imaging type, division and total statistics"
72 S DIR("?",3)="Enter 'D' to obtain division and total statistics"
73 S DIR("?",4)="Enter 'T' to obtain total statistics only"
74 S DIR("?")="Enter '^' to stop." D ^DIR K DIR
75 I $D(DIRUT) K DIROUT,DIRUT,DTOUT,DUOUT,I,RAPSTX Q
76 S RARPT=$S(Y="L":1,Y="I":2,Y="D":3,1:4)
77 S X=$$DIVLOC^RAUTL7()
78 S:'X ZTDESC="Rad/Nuc Med Examination Statistics" G:'X RAESR
79 D PURGE^RAESR2
80 Q
Note: See TracBrowser for help on using the repository browser.