- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTUVR.m
r613 r623 1 RARTUVR ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:01 2 ;;5.0;Radiology/Nuclear Medicine;**29,56**;Mar 16, 1998;Build 3 3 ; 4 ; This routine displays the total number of reports that have a status 5 ; other than V(erify) and the report is linked to a Resident, Staff or 6 ; unknown physician. It builds the report by using the 'ASTAT' cross 7 ; reference on File 74. It displays the report by division and imaging 8 ; type. Within division/imaging type, it displays the number of reports 9 ; by category (Resident and Staff). It displays the number of unverified 10 ; reports by Interpreting Physician within a category. 11 ; The routine checks the PRIMARY INTERPRETING RESIDENT and PRIMARY 12 ; INTERPRETING STAFF fields (File 70) associated with a report. 13 ; If a primary Resident is associated with the report, then the report 14 ; is counted towards that Resident. 15 ; If a primary Staff physician is associated with the report, then the 16 ; report is counted towards that Interpreting Staff. 17 ; If neither of the above are true the report is counted toward unknown. 18 ; 19 EN ; unverified reports report 20 K ^TMP($J) 21 I '$D(^RARPT("ASTAT")) W !!,*7,?5,"There are no Unverified Reports." Q 22 ; 23 ; Select Imaging Type, if exists 24 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX="" 25 S RAXIT=$$SETUPDI^RAUTL7() I RAXIT K RAXIT Q 26 S X=$$DIVLOC^RAUTL7() I X D KILL Q 27 S RACNT=0,X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D 28 . Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y="" 29 . F S Y=$O(RACCESS(DUZ,"DIV-IMG",X,Y)) Q:Y']"" D 30 .. S:$D(^TMP($J,"RA I-TYPE",Y)) ^TMP($J,"RAUVR",X,Y)=0,RACNT=RACNT+1 31 .. Q 32 . Q 33 W ! 34 ASKBD K DIR S DIR("B")="b" 35 S DIR("?",1)="Enter 'b' for a brief format, 'd' for a detailed format, " 36 S DIR("?",2)="'e' for a format sorted by exam date, 's' for a format" 37 S DIR("?",3)="sorted by Primary Interpreting Staff." 38 S DIR("?")="This is mandatory." 39 S DIR(0)="S^b:Brief;d:Detailed;e:Exam Date, Itemized List;s:Staff, Itemized List" 40 D ^DIR G:$D(DIRUT) KILL 41 S RABD=$$UP^XLFSTR(Y) K DIR,DIROUT,DIRUT,DUOUT,DTOUT 42 I RABD="S"!(RABD="E") D 43 . W ! D 132^RAMAINP S RAFILE="EXAM REGISTERED" 44 . Q 45 E S RAFILE="REPORT ENTERED" 46 ; 47 ASKTHRU S RASKTIME=1 W !!,"(The date range refers to DATE "_RAFILE_")" 48 D DATE^RAUTL K RAFILE,RASKTIME ;allow time of day input 49 G:X="^" KILL G:'$D(ENDDATE)!('$D(BEGDATE)) KILL 50 S:$L(ENDDATE)=7 ENDDATE=ENDDATE_".2359" 51 G:"^E^S^"[("^"_RABD_"^") DEVICE ; skip date/time cut-off 52 ; 53 ASKCUT S RACUT(1)=24,RACUT(2)=48,RACUT(3)=96 54 W !!,"Default cut-off limits (in hours) for aging of reports are :" 55 W !!?35 F RA1=1:1:3 W RACUT(RA1)," " 56 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" 57 W ! D ^DIR K DIR G:X="^" KILL G:+Y<1 DEVICE 58 S DIR("?")="Enter number of hours as the cut-off limit" 59 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 60 K DIR I +Y<1 W !!,"Try again " G ASKCUT 61 ; 62 DEVICE ; select device 63 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")="" 64 W ! D ZIS^RAUTL I RAPOP D KILL Q 65 START ; start processing 66 U IO S:$D(ZTQUEUED) ZTREQ="@" 67 I "^E^S^"[("^"_RABD_"^") D EN1^RARTUVR3 D KILL Q 68 S RADIVNME="" 69 F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME']"" S RAITNAME="" F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME']"" D 70 . S ^TMP($J,RADIVNME,RAITNAME,"RESCNT")=0 71 . S ^TMP($J,RADIVNME,RAITNAME,"STFCNT")=0 72 . S ^TMP($J,RADIVNME,RAITNAME,"UNKCNT")=0 73 . Q 74 ; 75 ; 76 S RASTATUS="",RAOUT=0 77 F S RASTATUS=$O(^RARPT("ASTAT",RASTATUS)) Q:RASTATUS=""!(RAOUT) D 78 . S RARPT=0,RAOUT=0 79 . F S RARPT=$O(^RARPT("ASTAT",RASTATUS,RARPT)) Q:RARPT'>0!(RAOUT) D 80 ..;use Report Status to exclude, as Verf'd rpt may have leftover "ASTAT" 81 ..;exclude Verified, Deleted, and Electronically Filed reports 82 .. Q:"^V^X^EF^"[("^"_$P($G(^RARPT(RARPT,0)),U,5)_"^") 83 .. S RARPTENT=$P($G(^RARPT(RARPT,0)),U,6) 84 .. Q:RARPTENT<BEGDATE!(RARPTENT>ENDDATE) 85 .. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1 86 .. S Y=RARPT D RASET^RAUTL2 Q:'Y S RAX=Y 87 .. S RAPRES=$P(RAX,"^",12),RAPSTF=$P(RAX,"^",15) 88 .. ; Check if Staff & Resident the same, if so, use Staff only 89 .. I (RAPSTF>0),(RAPRES=RAPSTF) S RAPRES="" 90 .. S RAIP="" 91 .. S:RAPRES>0 RAIP=RAIP_"R" 92 .. S:RAPSTF>0 RAIP=RAIP_"S" 93 .. S:RAIP="" RAIP="U" 94 .. D BTG^RARTUVR1 95 .. Q 96 . Q 97 DIV ; walk through tmp global, start with 'division' 98 S (RACNT(0),RAOUT,RAPAGE)=0,RADIVNME="" 99 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDAT=Y 100 S $P(RADASH,"-",IOM)="",$P(RAEQUAL,"=",IOM+1)="" 101 F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME=""!(RAOUT) D IT Q:RAOUT D DIVSUM^RARTUVR1 Q:RAOUT 102 KILL ; kill variables & close device 103 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 104 K RA1,RA2,RA3,RA4,RABD,RACUT,RADASH,RAEQUAL,RAHOURS,RARPTENT,RARUNDAT,RASSN 105 K:$D(RAPSTX) RACCESS,RAPSTX 106 K BEGDATE,DIR,DIRUT,DUOUT,ENDDATE,I,RAMES,ZTDESC,ZTRTN,ZTSAVE 107 D CLOSE^RAUTL 108 Q 109 IT ; imaging type 110 S RAITNAME="" 111 F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME=""!(RAOUT) D PRINT^RARTUVR2 Q:RAOUT 112 Q 113 ; 1 RARTUVR ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:01 2 ;;5.0;Radiology/Nuclear Medicine;**29**;Mar 16, 1998 3 ; 4 ; This routine displays the total number of reports that have a status 5 ; other than V(erify) and the report is linked to a Resident, Staff or 6 ; unknown physician. It builds the report by using the 'ASTAT' cross 7 ; reference on File 74. It displays the report by division and imaging 8 ; type. Within division/imaging type, it displays the number of reports 9 ; by category (Resident and Staff). It displays the number of unverified 10 ; reports by Interpreting Physician within a category. 11 ; The routine checks the PRIMARY INTERPRETING RESIDENT and PRIMARY 12 ; INTERPRETING STAFF fields (File 70) associated with a report. 13 ; If a primary Resident is associated with the report, then the report 14 ; is counted towards that Resident. 15 ; If a primary Staff physician is associated with the report, then the 16 ; report is counted towards that Interpreting Staff. 17 ; If neither of the above are true the report is counted toward unknown. 18 ; 19 EN ; unverified reports report 20 K ^TMP($J) 21 I '$D(^RARPT("ASTAT")) W !!,*7,?5,"There are no Unverified Reports." Q 22 ; 23 ; Select Imaging Type, if exists 24 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX="" 25 S RAXIT=$$SETUPDI^RAUTL7() I RAXIT K RAXIT Q 26 S X=$$DIVLOC^RAUTL7() I X D KILL Q 27 S RACNT=0,X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D 28 . Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y="" 29 . F S Y=$O(RACCESS(DUZ,"DIV-IMG",X,Y)) Q:Y']"" D 30 .. S:$D(^TMP($J,"RA I-TYPE",Y)) ^TMP($J,"RAUVR",X,Y)=0,RACNT=RACNT+1 31 .. Q 32 . Q 33 W ! 34 ASKBD K DIR S DIR("B")="b" 35 S DIR("?",1)="Enter 'b' for a brief format, 'd' for a detailed format, " 36 S DIR("?",2)="'e' for a format sorted by exam date, 's' for a format" 37 S DIR("?",3)="sorted by Primary Interpreting Staff." 38 S DIR("?")="This is mandatory." 39 S DIR(0)="S^b:Brief;d:Detailed;e:Exam Date, Itemized List;s:Staff, Itemized List" 40 D ^DIR G:$D(DIRUT) KILL 41 S RABD=$$UP^XLFSTR(Y) K DIR,DIROUT,DIRUT,DUOUT,DTOUT 42 I RABD="S"!(RABD="E") D 43 . W ! D 132^RAMAINP S RAFILE="EXAM REGISTERED" 44 . Q 45 E S RAFILE="REPORT ENTERED" 46 ; 47 ASKTHRU S RASKTIME=1 W !!,"(The date range refers to DATE "_RAFILE_")" 48 D DATE^RAUTL K RAFILE,RASKTIME ;allow time of day input 49 G:X="^" KILL G:'$D(ENDDATE)!('$D(BEGDATE)) KILL 50 S:$L(ENDDATE)=7 ENDDATE=ENDDATE_".2359" 51 G:"^E^S^"[("^"_RABD_"^") DEVICE ; skip date/time cut-off 52 ; 53 ASKCUT S RACUT(1)=24,RACUT(2)=48,RACUT(3)=96 54 W !!,"Default cut-off limits (in hours) for aging of reports are :" 55 W !!?35 F RA1=1:1:3 W RACUT(RA1)," " 56 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" 57 W ! D ^DIR K DIR G:X="^" KILL G:+Y<1 DEVICE 58 S DIR("?")="Enter number of hours as the cut-off limit" 59 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 60 K DIR I +Y<1 W !!,"Try again " G ASKCUT 61 ; 62 DEVICE ; select device 63 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")="" 64 W ! D ZIS^RAUTL I RAPOP D KILL Q 65 START ; start processing 66 U IO S:$D(ZTQUEUED) ZTREQ="@" 67 I "^E^S^"[("^"_RABD_"^") D EN1^RARTUVR3 D KILL Q 68 S RADIVNME="" 69 F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME']"" S RAITNAME="" F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME']"" D 70 . S ^TMP($J,RADIVNME,RAITNAME,"RESCNT")=0 71 . S ^TMP($J,RADIVNME,RAITNAME,"STFCNT")=0 72 . S ^TMP($J,RADIVNME,RAITNAME,"UNKCNT")=0 73 . Q 74 ; 75 ; 76 S RASTATUS="",RAOUT=0 77 F S RASTATUS=$O(^RARPT("ASTAT",RASTATUS)) Q:RASTATUS=""!(RAOUT) D 78 . Q:RASTATUS="V" 79 . S RARPT=0,RAOUT=0 80 . F S RARPT=$O(^RARPT("ASTAT",RASTATUS,RARPT)) Q:RARPT'>0!(RAOUT) D 81 .. S RARPTENT=$P($G(^RARPT(RARPT,0)),U,6) 82 .. Q:RARPTENT<BEGDATE!(RARPTENT>ENDDATE) 83 .. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1 84 .. S Y=RARPT D RASET^RAUTL2 Q:'Y S RAX=Y 85 .. S RAPRES=$P(RAX,"^",12),RAPSTF=$P(RAX,"^",15) 86 .. ; Check if Staff & Resident the same, if so, use Staff only 87 .. I (RAPSTF>0),(RAPRES=RAPSTF) S RAPRES="" 88 .. S RAIP="" 89 .. S:RAPRES>0 RAIP=RAIP_"R" 90 .. S:RAPSTF>0 RAIP=RAIP_"S" 91 .. S:RAIP="" RAIP="U" 92 .. D BTG^RARTUVR1 93 .. Q 94 . Q 95 DIV ; walk through tmp global, start with 'division' 96 S (RACNT(0),RAOUT,RAPAGE)=0,RADIVNME="" 97 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDAT=Y 98 S $P(RADASH,"-",IOM)="",$P(RAEQUAL,"=",IOM+1)="" 99 F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME=""!(RAOUT) D IT Q:RAOUT D DIVSUM^RARTUVR1 Q:RAOUT 100 KILL ; kill variables & close device 101 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 102 K RA1,RA2,RA3,RA4,RABD,RACUT,RADASH,RAEQUAL,RAHOURS,RARPTENT,RARUNDAT,RASSN 103 K:$D(RAPSTX) RACCESS,RAPSTX 104 K BEGDATE,DIR,DIRUT,DUOUT,ENDDATE,I,RAMES,ZTDESC,ZTRTN,ZTSAVE 105 D CLOSE^RAUTL 106 Q 107 IT ; imaging type 108 S RAITNAME="" 109 F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME=""!(RAOUT) D PRINT^RARTUVR2 Q:RAOUT 110 Q 111 ;
Note:
See TracChangeset
for help on using the changeset viewer.
