DVBAB58 ;ALB/SPH - CAPRI INSUFF EXAM TRACKING REPORT ;09/06/00
;;2.7;AMIE;**35,193**;Apr 10, 1995;Build 84
;
STRT(ZMSG,BEGDT,ENDDT,RPTTYPE) ;
MAIN ;**Select Dte Rng & Rpt Type; call report routine
F Q:$D(DVBAOUT) DO
.;D HOME^%ZIS
.;S TVAR(1,0)="0,0,1,2:2,1^Insufficient 2507 Exam Report"
.;D WR^DVBAUTL4("TVAR")
.;K TVAR
.;S RPTTYPE=$$RPTTYPE^DVBCUTA1()
.S:((RPTTYPE'="D")&(RPTTYPE'="S")) DVBAOUT=""
.;W:'$D(DVBAOUT) !!
.;D:'$D(DVBAOUT) DATE^DVBCUTL4(.BEGDT,.ENDDT)
.I $D(ENDDT),(+ENDDT>0) DO
..S ENDDT=ENDDT_".2359"
..I RPTTYPE="S" DO
...D DEVSEL
...I POP D SUMKILL
...I 'POP DO
....I $D(IO("Q")) DO
.....N DVBAI
.....S ZTRTN="SUM^DVBCIRPT",ZTIO=ION
.....S ZTDESC="Summary Insufficient Exam Report"
.....F DVBAI="BEGDT","ENDDT" S ZTSAVE(DVBAI)=""
.....D ^%ZTLOAD
.....N TSK S TSK=$S($D(ZTSK)=0:"C",1:"Y")
.....I TSK="Y" W !!,"Summary Report Queued. Task number: ",ZTSK
.....K ZTSK D CONTMES^DVBCUTL4
.....D SUMKILL
....I '$D(IO("Q")) D SUM
...D ^%ZISC
..I RPTTYPE="D" DO
...D DETSEL^DVBCIRP1 ;**Select the Reasons and Exams to report
...I '$D(DVBAQTSL) DO
....D DEVSEL
....I POP D KVARS^DVBCIRP1
....I 'POP DO
.....I $D(IO("Q")) DO
......N DVBAI
......S ZTRTN="DETAIL^DVBCIRP1",ZTIO=ION
......S ZTDESC="Detailed Insufficient Exam Report"
......F DVBAI="BEGDT","ENDDT","DVBAARY(""REASON"",","^TMP($J,""XMTYPE""," S ZTSAVE(DVBAI)=""
......D ^%ZTLOAD
......N TSK S TSK=$S($D(ZTSK)=0:"C",1:"Y")
......I TSK="Y" W !!,"Detail Report Queued. Task number: ",ZTSK
......K ZTSK D CONTMES^DVBCUTL4
......D KVARS^DVBCIRP1
.....I '$D(IO("Q")) W:IOST?1"C-".E @IOF D DETAIL^DVBCIRP1
....D ^%ZISC
...K DVBAQTSL
..D CLEANUP
D KVARS
Q
;
KVARS ;** Kill the variables used in report
K DVBAOUT,ENDDT,BEGDT,DTOUT,DUOUT,RPTTYPE,DVBACAN,DVBASTAT
D CLEANUP
Q
;
CLEANUP ;** Kill the variables used by the device handler
K %ZIS,POP,%IS,IOP
Q
;
DEVSEL ;** Select the device to report to
S %ZIS="AEQ"
S %ZIS("A")="Output device: "
D ^%ZIS
Q
;
SUM ;** Set up reason counter array, count all 2507's received
U IO
S (DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM)=0
S DVBACAN("REQ")=0,DVBACAN("EXM")=0
S DVBAENDL=ENDDT
;
;** Initialize reason counter array
F DVBARIFN=0:0 S DVBARIFN=$O(^DVB(396.94,DVBARIFN)) Q:+DVBARIFN'>0 DO
.S DVBAINXM(DVBARIFN)=0
S DVBAINXM("NO REASON")=0
;
;** Count the total and insufficient number of exams and 2507 requests
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
...S DVBARQCT=DVBARQCT+1
...K DVBAINSF
...I DVBAPRIO="E" DO
....S DVBAINRQ=DVBAINRQ+1
....;AJF ;Request Status Convertion
....I $P(^DVB(396.3,DVBADALP,0),U,18)=7 S DVBACAN("REQ")=DVBACAN("REQ")+1
....S DVBAINSF=""
...S DVBAXMDA=""
...F S DVBAXMDA=$O(^DVB(396.4,"C",DVBADALP,DVBAXMDA)) Q:DVBAXMDA="" DO
....S DVBAXMCT=DVBAXMCT+1
....I $D(DVBAINSF) DO
.....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 DVBAINXM(DVBARIFN)=DVBAINXM(DVBARIFN)+1
.....I DVBASTAT="RX" S DVBACAN("EXM")=DVBACAN("EXM")+1
D SUMRPT^DVBCIRP1
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB58 3644 printed Sep 23, 2025@19:16:30 Page 2
DVBAB58 ;ALB/SPH - CAPRI INSUFF EXAM TRACKING REPORT ;09/06/00
+1 ;;2.7;AMIE;**35,193**;Apr 10, 1995;Build 84
+2 ;
STRT(ZMSG,BEGDT,ENDDT,RPTTYPE) ;
MAIN ;**Select Dte Rng & Rpt Type; call report routine
+1 FOR
if $DATA(DVBAOUT)
QUIT
Begin DoDot:1
+2 ;D HOME^%ZIS
+3 ;S TVAR(1,0)="0,0,1,2:2,1^Insufficient 2507 Exam Report"
+4 ;D WR^DVBAUTL4("TVAR")
+5 ;K TVAR
+6 ;S RPTTYPE=$$RPTTYPE^DVBCUTA1()
+7 if ((RPTTYPE'="D")&(RPTTYPE'="S"))
SET DVBAOUT=""
+8 ;W:'$D(DVBAOUT) !!
+9 ;D:'$D(DVBAOUT) DATE^DVBCUTL4(.BEGDT,.ENDDT)
+10 IF $DATA(ENDDT)
IF (+ENDDT>0)
Begin DoDot:2
+11 SET ENDDT=ENDDT_".2359"
+12 IF RPTTYPE="S"
Begin DoDot:3
+13 DO DEVSEL
+14 IF POP
DO SUMKILL
+15 IF 'POP
Begin DoDot:4
+16 IF $DATA(IO("Q"))
Begin DoDot:5
+17 NEW DVBAI
+18 SET ZTRTN="SUM^DVBCIRPT"
SET ZTIO=ION
+19 SET ZTDESC="Summary Insufficient Exam Report"
+20 FOR DVBAI="BEGDT","ENDDT"
SET ZTSAVE(DVBAI)=""
+21 DO ^%ZTLOAD
+22 NEW TSK
SET TSK=$SELECT($DATA(ZTSK)=0:"C",1:"Y")
+23 IF TSK="Y"
WRITE !!,"Summary Report Queued. Task number: ",ZTSK
+24 KILL ZTSK
DO CONTMES^DVBCUTL4
+25 DO SUMKILL
End DoDot:5
+26 IF '$DATA(IO("Q"))
DO SUM
End DoDot:4
+27 DO ^%ZISC
End DoDot:3
+28 IF RPTTYPE="D"
Begin DoDot:3
+29 ;**Select the Reasons and Exams to report
DO DETSEL^DVBCIRP1
+30 IF '$DATA(DVBAQTSL)
Begin DoDot:4
+31 DO DEVSEL
+32 IF POP
DO KVARS^DVBCIRP1
+33 IF 'POP
Begin DoDot:5
+34 IF $DATA(IO("Q"))
Begin DoDot:6
+35 NEW DVBAI
+36 SET ZTRTN="DETAIL^DVBCIRP1"
SET ZTIO=ION
+37 SET ZTDESC="Detailed Insufficient Exam Report"
+38 FOR DVBAI="BEGDT","ENDDT","DVBAARY(""REASON"",","^TMP($J,""XMTYPE"","
SET ZTSAVE(DVBAI)=""
+39 DO ^%ZTLOAD
+40 NEW TSK
SET TSK=$SELECT($DATA(ZTSK)=0:"C",1:"Y")
+41 IF TSK="Y"
WRITE !!,"Detail Report Queued. Task number: ",ZTSK
+42 KILL ZTSK
DO CONTMES^DVBCUTL4
+43 DO KVARS^DVBCIRP1
End DoDot:6
+44 IF '$DATA(IO("Q"))
if IOST?1"C-".E
WRITE @IOF
DO DETAIL^DVBCIRP1
End DoDot:5
+45 DO ^%ZISC
End DoDot:4
+46 KILL DVBAQTSL
End DoDot:3
+47 DO CLEANUP
End DoDot:2
End DoDot:1
+48 DO KVARS
+49 QUIT
+50 ;
KVARS ;** Kill the variables used in report
+1 KILL DVBAOUT,ENDDT,BEGDT,DTOUT,DUOUT,RPTTYPE,DVBACAN,DVBASTAT
+2 DO CLEANUP
+3 QUIT
+4 ;
CLEANUP ;** Kill the variables used by the device handler
+1 KILL %ZIS,POP,%IS,IOP
+2 QUIT
+3 ;
DEVSEL ;** Select the device to report to
+1 SET %ZIS="AEQ"
+2 SET %ZIS("A")="Output device: "
+3 DO ^%ZIS
+4 QUIT
+5 ;
SUM ;** Set up reason counter array, count all 2507's received
+1 USE IO
+2 SET (DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM)=0
+3 SET DVBACAN("REQ")=0
SET DVBACAN("EXM")=0
+4 SET DVBAENDL=ENDDT
+5 ;
+6 ;** Initialize reason counter array
+7 FOR DVBARIFN=0:0
SET DVBARIFN=$ORDER(^DVB(396.94,DVBARIFN))
if +DVBARIFN'>0
QUIT
Begin DoDot:1
+8 SET DVBAINXM(DVBARIFN)=0
End DoDot:1
+9 SET DVBAINXM("NO REASON")=0
+10 ;
+11 ;** Count the total and insufficient number of exams and 2507 requests
+12 SET DVBADTLP=BEGDT-.0001
+13 FOR
SET DVBADTLP=$ORDER(^DVB(396.3,"ADP",DVBADTLP))
if (DVBADTLP=""!(DVBADTLP>ENDDT))
QUIT
Begin DoDot:1
+14 SET DVBAPRIO=""
+15 FOR
SET DVBAPRIO=$ORDER(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO))
if DVBAPRIO=""
QUIT
Begin DoDot:2
+16 SET DVBADALP=""
+17 FOR
SET DVBADALP=$ORDER(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO,DVBADALP))
if DVBADALP=""
QUIT
Begin DoDot:3
+18 SET DVBARQCT=DVBARQCT+1
+19 KILL DVBAINSF
+20 IF DVBAPRIO="E"
Begin DoDot:4
+21 SET DVBAINRQ=DVBAINRQ+1
+22 ;AJF ;Request Status Convertion
+23 IF $PIECE(^DVB(396.3,DVBADALP,0),U,18)=7
SET DVBACAN("REQ")=DVBACAN("REQ")+1
+24 SET DVBAINSF=""
End DoDot:4
+25 SET DVBAXMDA=""
+26 FOR
SET DVBAXMDA=$ORDER(^DVB(396.4,"C",DVBADALP,DVBAXMDA))
if DVBAXMDA=""
QUIT
Begin DoDot:4
+27 SET DVBAXMCT=DVBAXMCT+1
+28 IF $DATA(DVBAINSF)
Begin DoDot:5
+29 SET DVBAINXM=DVBAINXM+1
+30 SET DVBARIFN=$PIECE(^DVB(396.4,DVBAXMDA,0),U,11)
SET DVBASTAT=$PIECE(^(0),U,4)
+31 if DVBARIFN=""
SET DVBARIFN="NO REASON"
+32 SET DVBAINXM(DVBARIFN)=DVBAINXM(DVBARIFN)+1
+33 IF DVBASTAT="RX"
SET DVBACAN("EXM")=DVBACAN("EXM")+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 DO SUMRPT^DVBCIRP1
+35 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+36 DO SUMKILL
+37 DO ^%ZISC
+38 QUIT
+39 ;
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 QUIT
