DVBCIRP1 ;ALB/GTS-AMIE INSUFFICIENT 2507 RPT -CONT 1 ; 11/10/94 1:30 PM
;;2.7;AMIE;**13,19,27,149,184,185**;Apr 10, 1995;Build 18
;Per VHA Directive 2004-038, this routine should not be modified.
;
;** Version Changes
; 2.7 - New routine (Enhc 15)
;
SUMRPT ;**Output the summary report
W:IOST?1"C-".E @IOF
D SUMHD
;print request data
W !?3,"Total 2507 requests received for date range:",?71,$J(DVBARQCT,5)
W !?3,"Total insufficient 2507 requests received for date range:",?71,$J(DVBAINRQ,5)
W !?3,"Total insufficient 2507 requests cancelled by RO for date range:",?71,$J(DVBACAN("REQ"),5)
I DVBARQCT>0 D
.S PERCENT=(DVBAINRQ/DVBARQCT)*100
.W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
.S PERCENT=((DVBAINRQ-DVBACAN("REQ"))/DVBARQCT)*100
.W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
I DVBARQCT'>0 D
.S PERCENT=0
.W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
.W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
;print exam data
W !!?3,"Total 2507 exams received for date range:",?71,$J(DVBAXMCT,5)
W !?3,"Total insufficient 2507 exams received for date range:",?71,$J(DVBAINXM,5)
W !?3,"Total insufficient 2507 exams cancelled by RO for date range:",?71,$J(DVBACAN("EXM"),5)
I DVBAXMCT>0 D
.S PERCENT=(DVBAINXM/DVBAXMCT)*100
.W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
.S PERCENT=((DVBAINXM-DVBACAN("EXM"))/DVBAXMCT)*100
.W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
I DVBAXMCT'>0 D
.S PERCENT=0
.W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
.W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
;print insufficient reason data
I IOST?1"C-".E DO
.K DTOUT,DUOUT
.W !!
.D PAUSE^DVBCUTL4
.I '$D(DTOUT),('$D(DUOUT)) DO
..W @IOF
..D SUMHD
I '$D(DTOUT),('$D(DUOUT)) DO
.W:IOST'?1"C-".E !!
.W !?15,"Summary of insufficient exams per Reason",!
.W !?3,"Reason",?53,"Num",?59,"Percent"
.N DVBARSLP S DVBARSLP=""
.F S DVBARSLP=$O(DVBAINXM(DVBARSLP)) Q:DVBARSLP="" DO ;**Reason tot's
..W:+DVBARSLP>0 !?3,$P(^DVB(396.94,DVBARSLP,0),U,3),?53,DVBAINXM(DVBARSLP)
..I +DVBARSLP'>0,(+DVBAINXM(DVBARSLP)>0) W !?3,"Exams without insufficient reason indicated",?53,DVBAINXM(DVBARSLP)
..W:(+DVBAINXM(DVBARSLP)>0&(DVBAINXM>0)) ?59,($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",1))_$S($E($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1)'="":"."_$E($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1),1:"")_" %"
.I IOST?1"C-".E DO
..D CONTMES^DVBCUTL4
Q
;
SUMHD ;** Output Summary Report heading
N STRTDT,LSTDT,DVBATXT,DVBASL
W !?15,"Summary Insufficient Exam Report for ",$$SITE^DVBCUTL4(),!
S Y=$P(BEGDT,".",1) X ^DD("DD") S STRTDT=Y K Y
S Y=$P(ENDDT,".",1) X ^DD("DD") S LSTDT=Y K Y
S DVBASL=$L($$SITE^DVBCUTL4)
S DVBATXT=$$PRHD^DVBCIUTL(DVBAPRTY)
W ?(((67+DVBASL)-$L(DVBATXT))\2),DVBATXT,!
W !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
Q
;
DETAIL ;** Output reason, exam type and exam info
N STRTDT,LSTDT,DVBARQST,DVBAEXMP,DVBAP,DVBAPREXM,MSGCNT
S MSGCNT=0
K ^TMP("DVBAEXAMS",$J),^TMP("INSUFF",$J)
S X=$P(BEGDT,".",1),STRTDT=$$FMTE^XLFDT(X,"5DZ")
S Y=$P(ENDDT,".",1),LSTDT=$$FMTE^XLFDT(Y,"5DZ")
U IO
S DVBADTLP=BEGDT
S DVBAENDL=ENDDT
S DVBAPRTY=$S(($G(DVBAPRTY)["BDD"):";BDD;QS;",($G(DVBAPRTY)["IDES"):";IDES;",($G(DVBAPRTY)["AO"):";AO;",1:"")
D:((DVBAPRTY']"")!(DVBAPRTY["AO")!(DVBAPRTY["IDES")) DETHD^DVBCIUTL
S RSDA=""
S DVBAPG1=""
F S RSDA=$O(DVBAARY("REASON",RSDA)) Q:(RSDA=""!($D(GETOUT))) DO
.K DVBARSPT
.S TPDA=""
.F S TPDA=$O(^TMP($J,"XMTYPE",TPDA)) Q:(TPDA=""!($D(GETOUT))) DO
..K DVBAXMPT
..S XMDA=""
..F S XMDA=$O(^DVB(396.4,"AIT",RSDA,TPDA,XMDA)) Q:(XMDA=""!($D(GETOUT))) DO
...S DVBARQST=$G(^DVB(396.3,$P(^DVB(396.4,XMDA,0),U,2),0))
...;retrieve Priority of Exam from Current/Parent(if exists) 2507 Request
...S DVBAPREXM=$$CHKREQ($P(^DVB(396.4,XMDA,0),U,2))
...I $P(DVBARQST,U,5)>DVBADTLP,($P(DVBARQST,U,5)<DVBAENDL) D
....;Current-As Is (All Others, except new priorities)
....D:((DVBAPRTY']"")&((";BDD;QS;IDES;AO;")'[(";"_DVBAPREXM_";"))) EXMOUT^DVBCIUTL
....;Report for Specific Priority of Exam(s)
....D:((DVBAPRTY]"")&(DVBAPRTY[(";"_DVBAPREXM_";")))
.....D:(DVBAPREXM="AO")!(DVBAPREXM="IDES") EXMOUT^DVBCIUTL ;Agent Orange or IDES Single Report
.....;BDD,QS require report for each priority code
.....;for performance grab all data then print 2 reports
.....S:(DVBAPREXM'="AO")&(DVBAPREXM'="IDES") ^TMP("DVBAEXAMS",$J,DVBAPREXM,RSDA,TPDA,XMDA)=""
I '$D(GETOUT),(IOST?1"C-".E),((DVBAPRTY']"")!(DVBAPRTY["AO")) D CONTMES^DVBCUTL4
D:((DVBAPRTY]"")&(DVBAPRTY'["AO")&(DVBAPRTY'["IDES")) ;print BDD reports
.K DVBAPG1 S DVBAEXMP=DVBAPRTY,RSDA=""
.F DVBAP=$P(DVBAEXMP,";",2),$P(DVBAEXMP,";",3) D
..Q:DVBAP=""
..S DVBAPRTY=DVBAP
..D DETHD^DVBCIUTL S DVBAPG1=""
..F S RSDA=$O(^TMP("DVBAEXAMS",$J,DVBAP,RSDA)) Q:(('+RSDA)!($D(GETOUT))) D
...K DVBARSPT S TPDA=""
...F S TPDA=$O(^TMP("DVBAEXAMS",$J,DVBAP,RSDA,TPDA)) Q:(('+TPDA)!($D(GETOUT))) D
....K DVBAXMPT S XMDA=""
....F S XMDA=$O(^TMP("DVBAEXAMS",$J,DVBAP,RSDA,TPDA,XMDA)) Q:(('+XMDA)!($D(GETOUT))) D EXMOUT^DVBCIUTL
..I '$D(GETOUT),(IOST?1"C-".E) D CONTMES^DVBCUTL4
..K GETOUT W !
D ^%ZISC
D KVARS ;**KILL the variables used by DETAIL
Q
;
KVARS ;** Final Kill for Detail report
S:$D(ZTQUEUED) ZTREQ="@"
K ^TMP($J),DVBAARY,DVBANAME,DVBASSN,DVBACNUM,RSDA,TPDA,XMDA,DVBADTLP,DVBAENDL
K DVBARSPT,DVBAXMPT,REQDA,DFN,DVBAORXM,DVBAXMTP,DVBACMND,DVBAORPV,DVBAORP1
K DVBADTWK,DVBADTE,DVBAORDT,DVBANAM1,GETOUT,DVBAARY,DVBAPG1,DVBARQDT,DVBAXDT
K DVBAXRS,MSGCNT,^TMP("DVBAEXAMS",$J)
Q
;
DETSEL ;** Select the details to report
D RSEL^DVBCIUTL
I '$D(DVBAARY("REASON")) S DVBAQTSL=""
I $D(DVBAQTSL) DO
.S DIR("A",1)="You have not selected Insufficient reasons to report."
.S DIR("A",2)="This is required to print the Detailed report."
.S DIR("A",3)=" "
.S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
I '$D(DVBAQTSL) DO
.D XMSEL^DVBCIUTL
.I '$D(^TMP($J,"XMTYPE")) S DVBAQTSL=""
.I $D(DVBAQTSL) DO
..S DIR("A",1)="You have not selected Exams to report."
..S DIR("A",2)="This is required to print the Detailed report."
..S DIR("A",3)=" "
..S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
..K DVBAARY("REASON")
Q
;
;Input: IEN of 2507 Request in File #396.3
;Output: Priority of Exam for the Current/Parent 2507 Request
CHKREQ(DVBARIEN) ;check for parent requests
N DVBAPIEN,DVBAPEXM
Q:($G(DVBARIEN)']"") ""
S DVBAPEXM=$P($G(^DVB(396.3,DVBARIEN,0)),U,10) ;Priority of Exam
S DVBAPIEN=$P($G(^DVB(396.3,DVBARIEN,5)),U) ;parent IEN if it exists
I (DVBAPIEN]"") D ;Parent 2507 Request
.S DVBAPEXM=$P($G(^DVB(396.3,DVBAPIEN,0)),U,10) ;Priority of Exam
Q DVBAPEXM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCIRP1 7117 printed Dec 13, 2024@01:44:32 Page 2
DVBCIRP1 ;ALB/GTS-AMIE INSUFFICIENT 2507 RPT -CONT 1 ; 11/10/94 1:30 PM
+1 ;;2.7;AMIE;**13,19,27,149,184,185**;Apr 10, 1995;Build 18
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;** Version Changes
+5 ; 2.7 - New routine (Enhc 15)
+6 ;
SUMRPT ;**Output the summary report
+1 if IOST?1"C-".E
WRITE @IOF
+2 DO SUMHD
+3 ;print request data
+4 WRITE !?3,"Total 2507 requests received for date range:",?71,$JUSTIFY(DVBARQCT,5)
+5 WRITE !?3,"Total insufficient 2507 requests received for date range:",?71,$JUSTIFY(DVBAINRQ,5)
+6 WRITE !?3,"Total insufficient 2507 requests cancelled by RO for date range:",?71,$JUSTIFY(DVBACAN("REQ"),5)
+7 IF DVBARQCT>0
Begin DoDot:1
+8 SET PERCENT=(DVBAINRQ/DVBARQCT)*100
+9 WRITE !?3,"% of insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
+10 SET PERCENT=((DVBAINRQ-DVBACAN("REQ"))/DVBARQCT)*100
+11 WRITE !?3,"% of uncancelled insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
End DoDot:1
+12 IF DVBARQCT'>0
Begin DoDot:1
+13 SET PERCENT=0
+14 WRITE !?3,"% of insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
+15 WRITE !?3,"% of uncancelled insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
End DoDot:1
+16 ;print exam data
+17 WRITE !!?3,"Total 2507 exams received for date range:",?71,$JUSTIFY(DVBAXMCT,5)
+18 WRITE !?3,"Total insufficient 2507 exams received for date range:",?71,$JUSTIFY(DVBAINXM,5)
+19 WRITE !?3,"Total insufficient 2507 exams cancelled by RO for date range:",?71,$JUSTIFY(DVBACAN("EXM"),5)
+20 IF DVBAXMCT>0
Begin DoDot:1
+21 SET PERCENT=(DVBAINXM/DVBAXMCT)*100
+22 WRITE !?3,"% of insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
+23 SET PERCENT=((DVBAINXM-DVBACAN("EXM"))/DVBAXMCT)*100
+24 WRITE !?3,"% of uncancelled insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
End DoDot:1
+25 IF DVBAXMCT'>0
Begin DoDot:1
+26 SET PERCENT=0
+27 WRITE !?3,"% of insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
+28 WRITE !?3,"% of uncancelled insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
End DoDot:1
+29 ;print insufficient reason data
+30 IF IOST?1"C-".E
Begin DoDot:1
+31 KILL DTOUT,DUOUT
+32 WRITE !!
+33 DO PAUSE^DVBCUTL4
+34 IF '$DATA(DTOUT)
IF ('$DATA(DUOUT))
Begin DoDot:2
+35 WRITE @IOF
+36 DO SUMHD
End DoDot:2
End DoDot:1
+37 IF '$DATA(DTOUT)
IF ('$DATA(DUOUT))
Begin DoDot:1
+38 if IOST'?1"C-".E
WRITE !!
+39 WRITE !?15,"Summary of insufficient exams per Reason",!
+40 WRITE !?3,"Reason",?53,"Num",?59,"Percent"
+41 NEW DVBARSLP
SET DVBARSLP=""
+42 ;**Reason tot's
FOR
SET DVBARSLP=$ORDER(DVBAINXM(DVBARSLP))
if DVBARSLP=""
QUIT
Begin DoDot:2
+43 if +DVBARSLP>0
WRITE !?3,$PIECE(^DVB(396.94,DVBARSLP,0),U,3),?53,DVBAINXM(DVBARSLP)
+44 IF +DVBARSLP'>0
IF (+DVBAINXM(DVBARSLP)>0)
WRITE !?3,"Exams without insufficient reason indicated",?53,DVBAINXM(DVBARSLP)
+45 if (+DVBAINXM(DVBARSLP)>0&(DVBAINXM>0))
WRITE ?59,($PIECE(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",1))_$SELECT($EXTRACT($PIECE(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1)'="":"."_$EXTRACT($PIECE(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1),1:"")_" %"
End DoDot:2
+46 IF IOST?1"C-".E
Begin DoDot:2
+47 DO CONTMES^DVBCUTL4
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
SUMHD ;** Output Summary Report heading
+1 NEW STRTDT,LSTDT,DVBATXT,DVBASL
+2 WRITE !?15,"Summary Insufficient Exam Report for ",$$SITE^DVBCUTL4(),!
+3 SET Y=$PIECE(BEGDT,".",1)
XECUTE ^DD("DD")
SET STRTDT=Y
KILL Y
+4 SET Y=$PIECE(ENDDT,".",1)
XECUTE ^DD("DD")
SET LSTDT=Y
KILL Y
+5 SET DVBASL=$LENGTH($$SITE^DVBCUTL4)
+6 SET DVBATXT=$$PRHD^DVBCIUTL(DVBAPRTY)
+7 WRITE ?(((67+DVBASL)-$LENGTH(DVBATXT))\2),DVBATXT,!
+8 WRITE !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
+9 QUIT
+10 ;
DETAIL ;** Output reason, exam type and exam info
+1 NEW STRTDT,LSTDT,DVBARQST,DVBAEXMP,DVBAP,DVBAPREXM,MSGCNT
+2 SET MSGCNT=0
+3 KILL ^TMP("DVBAEXAMS",$JOB),^TMP("INSUFF",$JOB)
+4 SET X=$PIECE(BEGDT,".",1)
SET STRTDT=$$FMTE^XLFDT(X,"5DZ")
+5 SET Y=$PIECE(ENDDT,".",1)
SET LSTDT=$$FMTE^XLFDT(Y,"5DZ")
+6 USE IO
+7 SET DVBADTLP=BEGDT
+8 SET DVBAENDL=ENDDT
+9 SET DVBAPRTY=$SELECT(($GET(DVBAPRTY)["BDD"):";BDD;QS;",($GET(DVBAPRTY)["IDES"):";IDES;",($GET(DVBAPRTY)["AO"):";AO;",1:"")
+10 if ((DVBAPRTY']"")!(DVBAPRTY["AO")!(DVBAPRTY["IDES"))
DO DETHD^DVBCIUTL
+11 SET RSDA=""
+12 SET DVBAPG1=""
+13 FOR
SET RSDA=$ORDER(DVBAARY("REASON",RSDA))
if (RSDA=""!($DATA(GETOUT)))
QUIT
Begin DoDot:1
+14 KILL DVBARSPT
+15 SET TPDA=""
+16 FOR
SET TPDA=$ORDER(^TMP($JOB,"XMTYPE",TPDA))
if (TPDA=""!($DATA(GETOUT)))
QUIT
Begin DoDot:2
+17 KILL DVBAXMPT
+18 SET XMDA=""
+19 FOR
SET XMDA=$ORDER(^DVB(396.4,"AIT",RSDA,TPDA,XMDA))
if (XMDA=""!($DATA(GETOUT)))
QUIT
Begin DoDot:3
+20 SET DVBARQST=$GET(^DVB(396.3,$PIECE(^DVB(396.4,XMDA,0),U,2),0))
+21 ;retrieve Priority of Exam from Current/Parent(if exists) 2507 Request
+22 SET DVBAPREXM=$$CHKREQ($PIECE(^DVB(396.4,XMDA,0),U,2))
+23 IF $PIECE(DVBARQST,U,5)>DVBADTLP
IF ($PIECE(DVBARQST,U,5)<DVBAENDL)
Begin DoDot:4
+24 ;Current-As Is (All Others, except new priorities)
+25 if ((DVBAPRTY']"")&((";BDD;QS;IDES;AO;")'[(";"_DVBAPREXM_";")))
DO EXMOUT^DVBCIUTL
+26 ;Report for Specific Priority of Exam(s)
+27 if ((DVBAPRTY]"")&(DVBAPRTY[(";"_DVBAPREXM_";")))
Begin DoDot:5
+28 ;Agent Orange or IDES Single Report
if (DVBAPREXM="AO")!(DVBAPREXM="IDES")
DO EXMOUT^DVBCIUTL
+29 ;BDD,QS require report for each priority code
+30 ;for performance grab all data then print 2 reports
+31 if (DVBAPREXM'="AO")&(DVBAPREXM'="IDES")
SET ^TMP("DVBAEXAMS",$JOB,DVBAPREXM,RSDA,TPDA,XMDA)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 IF '$DATA(GETOUT)
IF (IOST?1"C-".E)
IF ((DVBAPRTY']"")!(DVBAPRTY["AO"))
DO CONTMES^DVBCUTL4
+33 ;print BDD reports
if ((DVBAPRTY]"")&(DVBAPRTY'["AO")&(DVBAPRTY'["IDES"))
Begin DoDot:1
+34 KILL DVBAPG1
SET DVBAEXMP=DVBAPRTY
SET RSDA=""
+35 FOR DVBAP=$PIECE(DVBAEXMP,";",2),$PIECE(DVBAEXMP,";",3)
Begin DoDot:2
+36 if DVBAP=""
QUIT
+37 SET DVBAPRTY=DVBAP
+38 DO DETHD^DVBCIUTL
SET DVBAPG1=""
+39 FOR
SET RSDA=$ORDER(^TMP("DVBAEXAMS",$JOB,DVBAP,RSDA))
if (('+RSDA)!($DATA(GETOUT)))
QUIT
Begin DoDot:3
+40 KILL DVBARSPT
SET TPDA=""
+41 FOR
SET TPDA=$ORDER(^TMP("DVBAEXAMS",$JOB,DVBAP,RSDA,TPDA))
if (('+TPDA)!($DATA(GETOUT)))
QUIT
Begin DoDot:4
+42 KILL DVBAXMPT
SET XMDA=""
+43 FOR
SET XMDA=$ORDER(^TMP("DVBAEXAMS",$JOB,DVBAP,RSDA,TPDA,XMDA))
if (('+XMDA)!($DATA(GETOUT)))
QUIT
DO EXMOUT^DVBCIUTL
End DoDot:4
End DoDot:3
+44 IF '$DATA(GETOUT)
IF (IOST?1"C-".E)
DO CONTMES^DVBCUTL4
+45 KILL GETOUT
WRITE !
End DoDot:2
End DoDot:1
+46 DO ^%ZISC
+47 ;**KILL the variables used by DETAIL
DO KVARS
+48 QUIT
+49 ;
KVARS ;** Final Kill for Detail report
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB),DVBAARY,DVBANAME,DVBASSN,DVBACNUM,RSDA,TPDA,XMDA,DVBADTLP,DVBAENDL
+3 KILL DVBARSPT,DVBAXMPT,REQDA,DFN,DVBAORXM,DVBAXMTP,DVBACMND,DVBAORPV,DVBAORP1
+4 KILL DVBADTWK,DVBADTE,DVBAORDT,DVBANAM1,GETOUT,DVBAARY,DVBAPG1,DVBARQDT,DVBAXDT
+5 KILL DVBAXRS,MSGCNT,^TMP("DVBAEXAMS",$JOB)
+6 QUIT
+7 ;
DETSEL ;** Select the details to report
+1 DO RSEL^DVBCIUTL
+2 IF '$DATA(DVBAARY("REASON"))
SET DVBAQTSL=""
+3 IF $DATA(DVBAQTSL)
Begin DoDot:1
+4 SET DIR("A",1)="You have not selected Insufficient reasons to report."
+5 SET DIR("A",2)="This is required to print the Detailed report."
+6 SET DIR("A",3)=" "
+7 SET DIR(0)="FAO^1:1"
SET DIR("A")="Hit Return to continue."
DO ^DIR
KILL DIR,X,Y
End DoDot:1
+8 IF '$DATA(DVBAQTSL)
Begin DoDot:1
+9 DO XMSEL^DVBCIUTL
+10 IF '$DATA(^TMP($JOB,"XMTYPE"))
SET DVBAQTSL=""
+11 IF $DATA(DVBAQTSL)
Begin DoDot:2
+12 SET DIR("A",1)="You have not selected Exams to report."
+13 SET DIR("A",2)="This is required to print the Detailed report."
+14 SET DIR("A",3)=" "
+15 SET DIR(0)="FAO^1:1"
SET DIR("A")="Hit Return to continue."
DO ^DIR
KILL DIR,X,Y
+16 KILL DVBAARY("REASON")
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;Input: IEN of 2507 Request in File #396.3
+20 ;Output: Priority of Exam for the Current/Parent 2507 Request
CHKREQ(DVBARIEN) ;check for parent requests
+1 NEW DVBAPIEN,DVBAPEXM
+2 if ($GET(DVBARIEN)']"")
QUIT ""
+3 ;Priority of Exam
SET DVBAPEXM=$PIECE($GET(^DVB(396.3,DVBARIEN,0)),U,10)
+4 ;parent IEN if it exists
SET DVBAPIEN=$PIECE($GET(^DVB(396.3,DVBARIEN,5)),U)
+5 ;Parent 2507 Request
IF (DVBAPIEN]"")
Begin DoDot:1
+6 ;Priority of Exam
SET DVBAPEXM=$PIECE($GET(^DVB(396.3,DVBAPIEN,0)),U,10)
End DoDot:1
+7 QUIT DVBAPEXM
