Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAESR

RAESR.m

Go to the documentation of this file. 
  1. RAESR ;HISC/GJC AISC/RMO-Exam Statistics Rpt ;1/20/95  09:03
  1.  ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1.  ; Zero out data globals!
  1.  S A="" F  S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']""  D
  1.  . Q:'$D(^TMP($J,"RA D-TYPE",A))
  1.  . S ^TMP($J,"RASTAT","RADIV",A)=0,B=""
  1.  . F  S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']""  D
  1.  .. Q:'$D(^TMP($J,"RA I-TYPE",B))
  1.  .. S ^TMP($J,"RASTAT","RAIMG",A,B)=0
  1.  .. Q
  1.  . Q
  1.  K RACCESS(DUZ,"DIV-IMG") S ZTRTN="START^RAESR"
  1.  F I="BEGDTX","ENDDTX","BEGDATE","ENDDATE","RARPT","RATMEFRM","^TMP($J,""RA D-TYPE"",","^TMP($J,""RA I-TYPE"",","^TMP($J,""RASTAT""," S ZTSAVE(I)=""
  1.  D DATE^RAUTL G:RAPOP PURGE^RAESR2
  1.  S BEGDTX=$$FMTE^XLFDT(BEGDATE,1),ENDDTX=$$FMTE^XLFDT(ENDDATE,1)
  1.  S RATMEFRM="For Period: "_BEGDTX_" to "_ENDDTX_"."
  1. DEV W ! D ZIS^RAUTL G:RAPOP PURGE^RAESR2
  1. START ; Set-up date variables for selected date range.
  1.  ; NOTE: RADTE is the exam reg date/time, and RADTI is the
  1.  ; internal date number
  1.  U IO S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999
  1.  S RACNB=6,RADU="C:CONTRACT;E:EMPLOYEE;I:INPATIENT;O:OUTPATIENT;R:RESEARCH;S:SHARING;"
  1.  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
  1.  G ^RAESR1 ; generate report
  1. RADFN ; Set RADFN the internal file number in the patient file, and check if
  1.  ; an Exam was registered on the specified date, RADTE
  1.  ; if so set RADO to the value of the Exam Registration node(Visit) via
  1.  ; the naked reference
  1.  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
  1.  Q
  1. RACNI ; Set RACNI the internal file number for an exam, and check for all
  1.  ; examinations performed during this patient visit
  1.  ; ^(RACNI,0), if so, set RAP0 to the value of the Examination node via
  1.  ; the naked reference
  1.  S RALNM=$S('$D(^RA(79.1,+$P(RAD0,"^",4),0)):"Unknown",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"Unknown")
  1.  S RAINM=$S($D(^RA(79.2,+$P(RAD0,"^",2),0)):$P(^(0),"^"),1:"Unknown")
  1.  S RACMP=$O(^RA(72,"AA",RAINM,9,0)) Q:'RACMP
  1.  ; Quit if no completed status for I-Type name.
  1.  S RADNM=$S($D(^DIC(4,+$P(RAD0,"^",3),0)):$P(^(0),"^"),1:"Unknown")
  1.  Q:'$D(^TMP($J,"RA D-TYPE",RADNM))!('$D(^TMP($J,"RA I-TYPE",RAINM)))
  1.  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
  1.  Q
  1. SETGLO ; Location Statistics
  1.  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
  1.  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
  1.  ; Imaging Type statistics
  1.  S:'$D(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT)) ^(RADAT)="" S Y=^(RADAT) D STATS S ^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT)=Y
  1.  S:'($D(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM))#2) ^(RAINM)="" S Y=^(RAINM) D STATS S ^TMP($J,"RASTAT","RAIMG",RADNM,RAINM)=Y
  1.  ; Division Statistics
  1.  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
  1.  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
  1.  ; Total Statistics
  1.  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
  1.  S:'($D(^TMP($J,"RASTAT","RATOT"))#2) ^("RATOT")="" S Y=^("RATOT") D SET:$D(RATMP),STATS:'$D(RATMP) S ^TMP($J,"RASTAT","RATOT")=Y
  1.  Q
  1. STATS ; Calculate statistics for # of Visits, # of Exams, # of complete
  1.  ; Exams and Category
  1.  S:'$D(RAFLG) RAFLG="",$P(RATMP,"^")=1 S $P(RATMP,"^",2)=1 S:$P(RAP0,"^",3)=RACMP $P(RATMP,"^",3)=1
  1.  ; set global ^TMP for statistics including category
  1.  F T=1:1 I RACTE=$E($P(RADU,";",T)) S $P(RATMP,"^",T+3)=1 Q
  1.  ;
  1. SET ; Set variable
  1.  F I=1:1:9 S $P(Y,"^",I)=$P(Y,"^",I)+$P(RATMP,"^",I)
  1.  Q
  1. ASK ; Entry point from RA DAISTATS (Examination Statistics) menu
  1.  K ^TMP($J,"RASTAT")
  1.  I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
  1.  S DIR(0)="S^L:Location;I:Imaging Type;D:Division;T:Totals Only"
  1.  S DIR("A")="Enter Report Detail Needed",DIR("B")="Location"
  1.  S DIR("?",1)="Enter 'L' to obtain location, imaging type, division and total statistics"
  1.  S DIR("?",2)="Enter 'I' to obtain imaging type, division and total statistics"
  1.  S DIR("?",3)="Enter 'D' to obtain division and total statistics"
  1.  S DIR("?",4)="Enter 'T' to obtain total statistics only"
  1.  S DIR("?")="Enter '^' to stop." D ^DIR K DIR
  1.  I $D(DIRUT) K DIROUT,DIRUT,DTOUT,DUOUT,I,RAPSTX Q
  1.  S RARPT=$S(Y="L":1,Y="I":2,Y="D":3,1:4)
  1.  S X=$$DIVLOC^RAUTL7()
  1.  S:'X ZTDESC="Rad/Nuc Med Examination Statistics" G:'X RAESR
  1.  D PURGE^RAESR2
  1.  Q