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

RARTUVR.m

Go to the documentation of this file.
  1. RARTUVR ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:01
  1. ;;5.0;Radiology/Nuclear Medicine;**29,56**;Mar 16, 1998;Build 3
  1. ;
  1. ; This routine displays the total number of reports that have a status
  1. ; other than V(erify) and the report is linked to a Resident, Staff or
  1. ; unknown physician. It builds the report by using the 'ASTAT' cross
  1. ; reference on File 74. It displays the report by division and imaging
  1. ; type. Within division/imaging type, it displays the number of reports
  1. ; by category (Resident and Staff). It displays the number of unverified
  1. ; reports by Interpreting Physician within a category.
  1. ; The routine checks the PRIMARY INTERPRETING RESIDENT and PRIMARY
  1. ; INTERPRETING STAFF fields (File 70) associated with a report.
  1. ; If a primary Resident is associated with the report, then the report
  1. ; is counted towards that Resident.
  1. ; If a primary Staff physician is associated with the report, then the
  1. ; report is counted towards that Interpreting Staff.
  1. ; If neither of the above are true the report is counted toward unknown.
  1. ;
  1. EN ; unverified reports report
  1. K ^TMP($J)
  1. I '$D(^RARPT("ASTAT")) W !!,*7,?5,"There are no Unverified Reports." Q
  1. ;
  1. ; Select Imaging Type, if exists
  1. I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
  1. S RAXIT=$$SETUPDI^RAUTL7() I RAXIT K RAXIT Q
  1. S X=$$DIVLOC^RAUTL7() I X D KILL Q
  1. S RACNT=0,X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D
  1. . Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y=""
  1. . F S Y=$O(RACCESS(DUZ,"DIV-IMG",X,Y)) Q:Y']"" D
  1. .. S:$D(^TMP($J,"RA I-TYPE",Y)) ^TMP($J,"RAUVR",X,Y)=0,RACNT=RACNT+1
  1. .. Q
  1. . Q
  1. W !
  1. ASKBD K DIR S DIR("B")="b"
  1. S DIR("?",1)="Enter 'b' for a brief format, 'd' for a detailed format, "
  1. S DIR("?",2)="'e' for a format sorted by exam date, 's' for a format"
  1. S DIR("?",3)="sorted by Primary Interpreting Staff."
  1. S DIR("?")="This is mandatory."
  1. S DIR(0)="S^b:Brief;d:Detailed;e:Exam Date, Itemized List;s:Staff, Itemized List"
  1. D ^DIR G:$D(DIRUT) KILL
  1. S RABD=$$UP^XLFSTR(Y) K DIR,DIROUT,DIRUT,DUOUT,DTOUT
  1. I RABD="S"!(RABD="E") D
  1. . W ! D 132^RAMAINP S RAFILE="EXAM REGISTERED"
  1. . Q
  1. E S RAFILE="REPORT ENTERED"
  1. ;
  1. ASKTHRU S RASKTIME=1 W !!,"(The date range refers to DATE "_RAFILE_")"
  1. D DATE^RAUTL K RAFILE,RASKTIME ;allow time of day input
  1. G:X="^" KILL G:'$D(ENDDATE)!('$D(BEGDATE)) KILL
  1. S:$L(ENDDATE)=7 ENDDATE=ENDDATE_".2359"
  1. G:"^E^S^"[("^"_RABD_"^") DEVICE ; skip date/time cut-off
  1. ;
  1. ASKCUT S RACUT(1)=24,RACUT(2)=48,RACUT(3)=96
  1. W !!,"Default cut-off limits (in hours) for aging of reports are :"
  1. W !!?35 F RA1=1:1:3 W RACUT(RA1)," "
  1. K DIR S DIR("A")="Do you want to enter different cut-off limits",DIR("B")="N",DIR("?")="Enter Y only if you want to change the above limits",DIR("??")="This is optional",DIR(0)="Y"
  1. W ! D ^DIR K DIR G:X="^" KILL G:+Y<1 DEVICE
  1. S DIR("?")="Enter number of hours as the cut-off limit"
  1. F RA1=1:1:3 S DIR(0)="N^"_$S(RA1=1:0,1:RACUT(RA1-1))_":87660",DIR("A")="Enter the "_$S(RA1=1:"first",RA1=2:"second",1:"third")_" cutoff hours" D ^DIR Q:+Y<1 S RACUT(RA1)=Y
  1. K DIR I +Y<1 W !!,"Try again " G ASKCUT
  1. ;
  1. DEVICE ; select device
  1. S ZTRTN="START^RARTUVR",ZTSAVE("^TMP($J,""RA D-TYPE"",")="",ZTSAVE("^TMP($J,""RA I-TYPE"",")="",ZTSAVE("^TMP($J,""RAUVR"",")="",ZTSAVE("RACNT")="",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("RACUT*")="",ZTSAVE("RABD")=""
  1. W ! D ZIS^RAUTL I RAPOP D KILL Q
  1. START ; start processing
  1. U IO S:$D(ZTQUEUED) ZTREQ="@"
  1. I "^E^S^"[("^"_RABD_"^") D EN1^RARTUVR3 D KILL Q
  1. S RADIVNME=""
  1. F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME']"" S RAITNAME="" F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME']"" D
  1. . S ^TMP($J,RADIVNME,RAITNAME,"RESCNT")=0
  1. . S ^TMP($J,RADIVNME,RAITNAME,"STFCNT")=0
  1. . S ^TMP($J,RADIVNME,RAITNAME,"UNKCNT")=0
  1. . Q
  1. ;
  1. ;
  1. S RASTATUS="",RAOUT=0
  1. F S RASTATUS=$O(^RARPT("ASTAT",RASTATUS)) Q:RASTATUS=""!(RAOUT) D
  1. . S RARPT=0,RAOUT=0
  1. . F S RARPT=$O(^RARPT("ASTAT",RASTATUS,RARPT)) Q:RARPT'>0!(RAOUT) D
  1. ..;use Report Status to exclude, as Verf'd rpt may have leftover "ASTAT"
  1. ..;exclude Verified, Deleted, and Electronically Filed reports
  1. .. Q:"^V^X^EF^"[("^"_$P($G(^RARPT(RARPT,0)),U,5)_"^")
  1. .. S RARPTENT=$P($G(^RARPT(RARPT,0)),U,6)
  1. .. Q:RARPTENT<BEGDATE!(RARPTENT>ENDDATE)
  1. .. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1
  1. .. S Y=RARPT D RASET^RAUTL2 Q:'Y S RAX=Y
  1. .. S RAPRES=$P(RAX,"^",12),RAPSTF=$P(RAX,"^",15)
  1. .. ; Check if Staff & Resident the same, if so, use Staff only
  1. .. I (RAPSTF>0),(RAPRES=RAPSTF) S RAPRES=""
  1. .. S RAIP=""
  1. .. S:RAPRES>0 RAIP=RAIP_"R"
  1. .. S:RAPSTF>0 RAIP=RAIP_"S"
  1. .. S:RAIP="" RAIP="U"
  1. .. D BTG^RARTUVR1
  1. .. Q
  1. . Q
  1. DIV ; walk through tmp global, start with 'division'
  1. S (RACNT(0),RAOUT,RAPAGE)=0,RADIVNME=""
  1. S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDAT=Y
  1. S $P(RADASH,"-",IOM)="",$P(RAEQUAL,"=",IOM+1)=""
  1. F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME=""!(RAOUT) D IT Q:RAOUT D DIVSUM^RARTUVR1 Q:RAOUT
  1. KILL ; kill variables & close device
  1. K ^TMP($J),POP,RAPOP,RACN,RACNI,RACNT,RAD,RADATE,RADFN,RADIVNME,RADIVNUM,RADTI,RADTE,RAFL,RAFLG,RAIP,RAIPNAME,RAITNAME,RAITNUM,RAOUT,RAPAGE,RAQUIT,RAPRES,RAPSTF,RARAD,RARE,RARPT,RARS,RASTATUS,RASTRING,RAX,RAXIT,X,Y,ZTQUEUED,ZTSTOP
  1. K RA1,RA2,RA3,RA4,RABD,RACUT,RADASH,RAEQUAL,RAHOURS,RARPTENT,RARUNDAT,RASSN
  1. K:$D(RAPSTX) RACCESS,RAPSTX
  1. K BEGDATE,DIR,DIRUT,DUOUT,ENDDATE,I,RAMES,ZTDESC,ZTRTN,ZTSAVE
  1. D CLOSE^RAUTL
  1. Q
  1. IT ; imaging type
  1. S RAITNAME=""
  1. F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME=""!(RAOUT) D PRINT^RARTUVR2 Q:RAOUT
  1. Q
  1. ;