DVBAB58.m

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 ---DVBAB58   3644     printed  Feb 18, 2025@23:06:55                                                                                                                                                                                                     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