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