DVBCIRP2 ;ALB/RTW - CAPRI INSUFFICIENT 2507 RPT -CONT 1 ; 07/17/2015 4:24 AM
;;2.7;AMIE;**192,193**;Apr 10, 1995;Build 84
;Copied DVBCIRP1 and to remove all Priority of exam filter code for CAPRI only
;CAPRI Insufficient Exam Report no longer uses priority of exam filters
;no longer uses insufficient reason filters
;** Version Changes
; 2.7 - New routine (Enhc 1)
;
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)
S DVBATXT=""
W ?(((67+DVBASL)-$L(DVBATXT))\2)
W !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
Q
;
DETAIL ;** Output reason, exam type and exam info
;RSDA is the reason ien
;TPDA is the exam type ien
;XMDA is the exam ien from 396.4
;DVBARQST is the request ien from 396.3
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 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))
...I $P(DVBARQST,U,5)>DVBADTLP,($P(DVBARQST,U,5)<DVBAENDL) D
....S ^TMP("DVBAEXAMS",$J,RSDA,TPDA,XMDA)=""
S DVBABIEN=DVBARQST
K DVBAPG1 S RSDA=""
D CAPDETHD^DVBCIUTL S DVBAPG1=""
F S RSDA=$O(^TMP("DVBAEXAMS",$J,RSDA)) Q:(('+RSDA)!($D(GETOUT))) D
.K DVBARSPT S TPDA=""
.F S TPDA=$O(^TMP("DVBAEXAMS",$J,RSDA,TPDA)) Q:(('+TPDA)!($D(GETOUT))) D
..K DVBAXMPT S XMDA=""
..F S XMDA=$O(^TMP("DVBAEXAMS",$J,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
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
SUM ;** Set up reason counter array, count all 2507's received
;copied from DVBCIRPT
N DVBAEXMP,DVBAI,DVBAP,DVBATVAR,DVBAMCDES,DVBAPREXM
U IO
S (DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM)=0
S DVBACAN("REQ")=0,DVBACAN("EXM")=0
S DVBAENDL=ENDDT
S DVBAEXMP=$S(($G(DVBAPRTY)["BDD"):";BDD;QS;",($G(DVBAPRTY)["IDES"):";IDES;",($G(DVBAPRTY)["AO"):";AO;",1:"")
; S DVBAMCDES=((DVBAEXMP]"")&(DVBAPRTY'="AO"))
S NUMRPTS=$L(DVBAEXMP,";")
S DVBAMCDES=((DVBAEXMP]"")&(NUMRPTS>3))
K ^TMP("DVBATOTALS",$J) ;for multiple priority reporting
;
;** Initialize reason counter array(s)
F DVBARIFN=0:0 S DVBARIFN=$O(^DVB(396.94,DVBARIFN)) Q:+DVBARIFN'>0 DO
.D:(DVBAMCDES)
..F DVBAP=$P(DVBAEXMP,";",2),$P(DVBAEXMP,";",3) D
...Q:DVBAP=""
...S ^TMP("DVBATOTALS",$J,DVBAP,"DVBAINXM",DVBARIFN)=0
.S DVBAINXM(DVBARIFN)=0
D:(DVBAMCDES)
.F DVBAP=$P(DVBAEXMP,";",2),$P(DVBAEXMP,";",3) D
..Q:DVBAP=""
..S ^TMP("DVBATOTALS",$J,DVBAP,"DVBAINXM","NO REASON")=0
S DVBAINXM("NO REASON")=0
;
;** Count the total and insufficient number of exams and 2507 requests
; For performance, if multiple reports, store totals in single pass of data
S DVBADTLP=BEGDT-.0001
F S DVBADTLP=$O(^DVB(396.3,"ADP",DVBADTLP)) Q:(DVBADTLP=""!(DVBADTLP>ENDDT)) DO
.S DVBAPRIO=""
.F S DVBAPRIO=$O(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO)) Q:DVBAPRIO="" DO
..S DVBADALP=""
..F S DVBADALP=$O(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO,DVBADALP)) Q:DVBADALP="" DO
...;check for Parent Request (retrieve current/parent Priority of Exam)
...S DVBAPREXM=$$CHKREQ(DVBADALP)
...S DVBAPREXM=""
...;original report run (Exclude new priorities)
...Q:((DVBAEXMP']"")&((";BDD;QS;IDES;AO;")[(";"_DVBAPREXM_";")))
...;report for specific Priority of Exam
...Q:((DVBAEXMP]"")&(DVBAEXMP'[(";"_DVBAPREXM_";")))
...S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBARQCT")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBARQCT"))+1
...S DVBARQCT=DVBARQCT+1
...K DVBAINSF
...I DVBAPRIO="E" DO
....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINRQ")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINRQ"))+1
....S DVBAINRQ=DVBAINRQ+1
....;AJF;Request Status conversion
....I $P(^DVB(396.3,DVBADALP,0),U,18)=7 D
.....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANREQ")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANREQ"))+1
.....S DVBACAN("REQ")=DVBACAN("REQ")+1
....S DVBAINSF=""
...S DVBAXMDA=""
...F S DVBAXMDA=$O(^DVB(396.4,"C",DVBADALP,DVBAXMDA)) Q:DVBAXMDA="" DO
....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAXMCT")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAXMCT"))+1
....S DVBAXMCT=DVBAXMCT+1
....I $D(DVBAINSF) DO
.....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM"))+1
.....S DVBAINXM=DVBAINXM+1
.....S DVBARIFN=$P(^DVB(396.4,DVBAXMDA,0),U,11),DVBASTAT=$P(^(0),U,4)
.....S:DVBARIFN="" DVBARIFN="NO REASON"
.....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM",DVBARIFN)=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM",DVBARIFN))+1
.....S DVBAINXM(DVBARIFN)=DVBAINXM(DVBARIFN)+1
.....I DVBASTAT="RX" D
......S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANEXM")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANEXM"))+1
......S DVBACAN("EXM")=DVBACAN("EXM")+1
;
S DVBAEXMP=$S(($G(DVBAPRTY)["BDD"):"BDD,QS",($G(DVBAPRTY)["IDES"):"IDES",($G(DVBAPRTY)["AO"):"AO",1:"")
F DVBAI=1:1:$L(DVBAEXMP,",") D
.S DVBAPRTY=$P(DVBAEXMP,",",DVBAI) ;priority to report on
.D:(DVBAI>1) ;Form Feed between multiple Reports
..S DVBATVAR(1,0)="0,0,0,0,1^"
..D WR^DVBAUTL4("DVBATVAR")
.;
.D:(DVBAMCDES) ;reset var cntrs for specific priority
..S DVBARQCT=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBARQCT"))
..S DVBAINRQ=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINRQ"))
..S DVBACAN("REQ")=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBACANREQ"))
..S DVBAXMCT=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAXMCT"))
..S DVBAINXM=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINXM"))
..S DVBAP=0 F S DVBAP=$O(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINXM",DVBAP)) Q:DVBAP="" D
...S DVBAINXM(DVBAP)=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINXM",DVBAP))
..S DVBACAN("EXM")=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBACANEXM"))
.;
.D SUMRPT ;print SUMMARY report
S:$D(ZTQUEUED) ZTREQ="@"
D SUMKILL
D ^%ZISC
Q
;
SUMKILL ;** Kill the variables used in the summary report
K DVBADTLP,DVBAENDL,DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM
K DVBAPRIO,DVBADALP,DVBAXMDA,DVBAINSF,DVBARIFN
K ^TMP("DVBATOTALS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCIRP2 9881 printed Apr 09, 2024@20:58:14 Page 2
DVBCIRP2 ;ALB/RTW - CAPRI INSUFFICIENT 2507 RPT -CONT 1 ; 07/17/2015 4:24 AM
+1 ;;2.7;AMIE;**192,193**;Apr 10, 1995;Build 84
+2 ;Copied DVBCIRP1 and to remove all Priority of exam filter code for CAPRI only
+3 ;CAPRI Insufficient Exam Report no longer uses priority of exam filters
+4 ;no longer uses insufficient reason filters
+5 ;** Version Changes
+6 ; 2.7 - New routine (Enhc 1)
+7 ;
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 ;S DVBATXT=$$PRHD^DVBCIUTL(DVBAPRTY)
+7 SET DVBATXT=""
+8 WRITE ?(((67+DVBASL)-$LENGTH(DVBATXT))\2)
+9 WRITE !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
+10 QUIT
+11 ;
DETAIL ;** Output reason, exam type and exam info
+1 ;RSDA is the reason ien
+2 ;TPDA is the exam type ien
+3 ;XMDA is the exam ien from 396.4
+4 ;DVBARQST is the request ien from 396.3
+5 NEW STRTDT,LSTDT,DVBARQST,DVBAEXMP,DVBAP,DVBAPREXM,MSGCNT
+6 SET MSGCNT=0
+7 KILL ^TMP("DVBAEXAMS",$JOB),^TMP("INSUFF",$JOB)
+8 SET X=$PIECE(BEGDT,".",1)
SET STRTDT=$$FMTE^XLFDT(X,"5DZ")
+9 SET Y=$PIECE(ENDDT,".",1)
SET LSTDT=$$FMTE^XLFDT(Y,"5DZ")
+10 USE IO
+11 SET DVBADTLP=BEGDT
+12 SET DVBAENDL=ENDDT
+13 SET RSDA=""
+14 SET DVBAPG1=""
+15 FOR
SET RSDA=$ORDER(DVBAARY("REASON",RSDA))
if (RSDA=""!($DATA(GETOUT)))
QUIT
Begin DoDot:1
+16 KILL DVBARSPT
+17 SET TPDA=""
+18 FOR
SET TPDA=$ORDER(^TMP($JOB,"XMTYPE",TPDA))
if (TPDA=""!($DATA(GETOUT)))
QUIT
Begin DoDot:2
+19 KILL DVBAXMPT
+20 SET XMDA=""
+21 FOR
SET XMDA=$ORDER(^DVB(396.4,"AIT",RSDA,TPDA,XMDA))
if (XMDA=""!($DATA(GETOUT)))
QUIT
Begin DoDot:3
+22 SET DVBARQST=$GET(^DVB(396.3,$PIECE(^DVB(396.4,XMDA,0),U,2),0))
+23 IF $PIECE(DVBARQST,U,5)>DVBADTLP
IF ($PIECE(DVBARQST,U,5)<DVBAENDL)
Begin DoDot:4
+24 SET ^TMP("DVBAEXAMS",$JOB,RSDA,TPDA,XMDA)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 SET DVBABIEN=DVBARQST
+26 KILL DVBAPG1
SET RSDA=""
+27 DO CAPDETHD^DVBCIUTL
SET DVBAPG1=""
+28 FOR
SET RSDA=$ORDER(^TMP("DVBAEXAMS",$JOB,RSDA))
if (('+RSDA)!($DATA(GETOUT)))
QUIT
Begin DoDot:1
+29 KILL DVBARSPT
SET TPDA=""
+30 FOR
SET TPDA=$ORDER(^TMP("DVBAEXAMS",$JOB,RSDA,TPDA))
if (('+TPDA)!($DATA(GETOUT)))
QUIT
Begin DoDot:2
+31 KILL DVBAXMPT
SET XMDA=""
+32 FOR
SET XMDA=$ORDER(^TMP("DVBAEXAMS",$JOB,RSDA,TPDA,XMDA))
if (('+XMDA)!($DATA(GETOUT)))
QUIT
DO EXMOUT^DVBCIUTL
End DoDot:2
End DoDot:1
+33 IF '$DATA(GETOUT)
IF (IOST?1"C-".E)
DO CONTMES^DVBCUTL4
+34 KILL GETOUT
WRITE !
+35 DO ^%ZISC
+36 ;**KILL the variables used by DETAIL
DO KVARS
+37 QUIT
+38 ;
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 QUIT
+4 ;
+5 ;
+6 ;Input: IEN of 2507 Request in File #396.3
+7 ;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
SUM ;** Set up reason counter array, count all 2507's received
+1 ;copied from DVBCIRPT
+2 NEW DVBAEXMP,DVBAI,DVBAP,DVBATVAR,DVBAMCDES,DVBAPREXM
+3 USE IO
+4 SET (DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM)=0
+5 SET DVBACAN("REQ")=0
SET DVBACAN("EXM")=0
+6 SET DVBAENDL=ENDDT
+7 SET DVBAEXMP=$SELECT(($GET(DVBAPRTY)["BDD"):";BDD;QS;",($GET(DVBAPRTY)["IDES"):";IDES;",($GET(DVBAPRTY)["AO"):";AO;",1:"")
+8 ; S DVBAMCDES=((DVBAEXMP]"")&(DVBAPRTY'="AO"))
+9 SET NUMRPTS=$LENGTH(DVBAEXMP,";")
+10 SET DVBAMCDES=((DVBAEXMP]"")&(NUMRPTS>3))
+11 ;for multiple priority reporting
KILL ^TMP("DVBATOTALS",$JOB)
+12 ;
+13 ;** Initialize reason counter array(s)
+14 FOR DVBARIFN=0:0
SET DVBARIFN=$ORDER(^DVB(396.94,DVBARIFN))
if +DVBARIFN'>0
QUIT
Begin DoDot:1
+15 if (DVBAMCDES)
Begin DoDot:2
+16 FOR DVBAP=$PIECE(DVBAEXMP,";",2),$PIECE(DVBAEXMP,";",3)
Begin DoDot:3
+17 if DVBAP=""
QUIT
+18 SET ^TMP("DVBATOTALS",$JOB,DVBAP,"DVBAINXM",DVBARIFN)=0
End DoDot:3
End DoDot:2
+19 SET DVBAINXM(DVBARIFN)=0
End DoDot:1
+20 if (DVBAMCDES)
Begin DoDot:1
+21 FOR DVBAP=$PIECE(DVBAEXMP,";",2),$PIECE(DVBAEXMP,";",3)
Begin DoDot:2
+22 if DVBAP=""
QUIT
+23 SET ^TMP("DVBATOTALS",$JOB,DVBAP,"DVBAINXM","NO REASON")=0
End DoDot:2
End DoDot:1
+24 SET DVBAINXM("NO REASON")=0
+25 ;
+26 ;** Count the total and insufficient number of exams and 2507 requests
+27 ; For performance, if multiple reports, store totals in single pass of data
+28 SET DVBADTLP=BEGDT-.0001
+29 FOR
SET DVBADTLP=$ORDER(^DVB(396.3,"ADP",DVBADTLP))
if (DVBADTLP=""!(DVBADTLP>ENDDT))
QUIT
Begin DoDot:1
+30 SET DVBAPRIO=""
+31 FOR
SET DVBAPRIO=$ORDER(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO))
if DVBAPRIO=""
QUIT
Begin DoDot:2
+32 SET DVBADALP=""
+33 FOR
SET DVBADALP=$ORDER(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO,DVBADALP))
if DVBADALP=""
QUIT
Begin DoDot:3
+34 ;check for Parent Request (retrieve current/parent Priority of Exam)
+35 SET DVBAPREXM=$$CHKREQ(DVBADALP)
+36 SET DVBAPREXM=""
+37 ;original report run (Exclude new priorities)
+38 if ((DVBAEXMP']"")&((";BDD;QS;IDES;AO;")[(";"_DVBAPREXM_";")))
QUIT
+39 ;report for specific Priority of Exam
+40 if ((DVBAEXMP]"")&(DVBAEXMP'[(";"_DVBAPREXM_";")))
QUIT
+41 if (DVBAMCDES)
SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBARQCT")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBARQCT"))+1
+42 SET DVBARQCT=DVBARQCT+1
+43 KILL DVBAINSF
+44 IF DVBAPRIO="E"
Begin DoDot:4
+45 if (DVBAMCDES)
SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINRQ")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINRQ"))+1
+46 SET DVBAINRQ=DVBAINRQ+1
+47 ;AJF;Request Status conversion
+48 IF $PIECE(^DVB(396.3,DVBADALP,0),U,18)=7
Begin DoDot:5
+49 if (DVBAMCDES)
SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANREQ")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANREQ"))+1
+50 SET DVBACAN("REQ")=DVBACAN("REQ")+1
End DoDot:5
+51 SET DVBAINSF=""
End DoDot:4
+52 SET DVBAXMDA=""
+53 FOR
SET DVBAXMDA=$ORDER(^DVB(396.4,"C",DVBADALP,DVBAXMDA))
if DVBAXMDA=""
QUIT
Begin DoDot:4
+54 if (DVBAMCDES)
SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAXMCT")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAXMCT"))+1
+55 SET DVBAXMCT=DVBAXMCT+1
+56 IF $DATA(DVBAINSF)
Begin DoDot:5
+57 if (DVBAMCDES)
SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM"))+1
+58 SET DVBAINXM=DVBAINXM+1
+59 SET DVBARIFN=$PIECE(^DVB(396.4,DVBAXMDA,0),U,11)
SET DVBASTAT=$PIECE(^(0),U,4)
+60 if DVBARIFN=""
SET DVBARIFN="NO REASON"
+61 if (DVBAMCDES)
SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM",DVBARIFN)=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM",DVBARIFN))+1
+62 SET DVBAINXM(DVBARIFN)=DVBAINXM(DVBARIFN)+1
+63 IF DVBASTAT="RX"
Begin DoDot:6
+64 if (DVBAMCDES)
SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANEXM")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANEXM"))+1
+65 SET DVBACAN("EXM")=DVBACAN("EXM")+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+66 ;
+67 SET DVBAEXMP=$SELECT(($GET(DVBAPRTY)["BDD"):"BDD,QS",($GET(DVBAPRTY)["IDES"):"IDES",($GET(DVBAPRTY)["AO"):"AO",1:"")
+68 FOR DVBAI=1:1:$LENGTH(DVBAEXMP,",")
Begin DoDot:1
+69 ;priority to report on
SET DVBAPRTY=$PIECE(DVBAEXMP,",",DVBAI)
+70 ;Form Feed between multiple Reports
if (DVBAI>1)
Begin DoDot:2
+71 SET DVBATVAR(1,0)="0,0,0,0,1^"
+72 DO WR^DVBAUTL4("DVBATVAR")
End DoDot:2
+73 ;
+74 ;reset var cntrs for specific priority
if (DVBAMCDES)
Begin DoDot:2
+75 SET DVBARQCT=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBARQCT"))
+76 SET DVBAINRQ=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINRQ"))
+77 SET DVBACAN("REQ")=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBACANREQ"))
+78 SET DVBAXMCT=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAXMCT"))
+79 SET DVBAINXM=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINXM"))
+80 SET DVBAP=0
FOR
SET DVBAP=$ORDER(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINXM",DVBAP))
if DVBAP=""
QUIT
Begin DoDot:3
+81 SET DVBAINXM(DVBAP)=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINXM",DVBAP))
End DoDot:3
+82 SET DVBACAN("EXM")=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBACANEXM"))
End DoDot:2
+83 ;
+84 ;print SUMMARY report
DO SUMRPT
End DoDot:1
+85 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+86 DO SUMKILL
+87 DO ^%ZISC
+88 QUIT
+89 ;
SUMKILL ;** Kill the variables used in the summary report
+1 KILL DVBADTLP,DVBAENDL,DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM
+2 KILL DVBAPRIO,DVBADALP,DVBAXMDA,DVBAINSF,DVBARIFN
+3 KILL ^TMP("DVBATOTALS",$JOB)
+4 QUIT
