- DVBCIRPT ;ALB/GTS-AMIE C&P INSUFF EXAM TRACKING RPT ; 11/9/94 2:00 PM
- ;;2.7;AMIE;**13,19,27,149,184,185,191,193**;Apr 10, 1995;Build 84
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;** Version Changes
- ; 2.7 - New routine (Enhc 15)
- ;
- MAIN ;**Select Dte Rng & Rpt Type; call report routine **
- ;**DVBA*2.7*191 initializes variable DVBADLMTR to zero before taskman call on detailed report**
- 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 DVBAPRTY=$$EXMPRTY^DVBCIUTL("Select Priority of Exam for the Insufficient Exam Report") ;priority of exam selection
- .S RPTTYPE=$S((DVBAPRTY?.A)&(DVBAPRTY]""):$$RPTTYPE^DVBCUTA1(),1:"")
- .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","DVBAPRTY" 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,ZTSAVE
- ......S ZTRTN="DETAIL^DVBCIRP1",ZTIO=ION
- ......S ZTDESC="Detailed Insufficient Exam Report"
- ......F DVBAI="BEGDT","ENDDT","DVBAPRTY","DVBAARY(""REASON"",","^TMP($J,""XMTYPE""," S ZTSAVE(DVBAI)="",ZTSAVE("DVBADLMTR")=0
- ......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 S DVBADLMTR=0 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,DVBAPRTY,DVBADLMTR,NUMRPTS
- D CLEANUP
- Q
- ;
- CLEANUP ;** Kill the variables used by the device handler
- K %ZIS,POP,%IS,IOP
- K IOBS,IOHG,IOPAR,IOUPAR,IOXY,POP,%DT,%YY,%XX,ION,IOPAR
- 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
- 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^DVBCIRP1(DVBADALP)
- ...;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^DVBCIRP1 ;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[HDVBCIRPT 7048 printed Apr 23, 2025@17:59:02 Page 2
- DVBCIRPT ;ALB/GTS-AMIE C&P INSUFF EXAM TRACKING RPT ; 11/9/94 2:00 PM
- +1 ;;2.7;AMIE;**13,19,27,149,184,185,191,193**;Apr 10, 1995;Build 84
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;** Version Changes
- +5 ; 2.7 - New routine (Enhc 15)
- +6 ;
- MAIN ;**Select Dte Rng & Rpt Type; call report routine **
- +1 ;**DVBA*2.7*191 initializes variable DVBADLMTR to zero before taskman call on detailed report**
- +2 FOR
- if $DATA(DVBAOUT)
- QUIT
- Begin DoDot:1
- +3 DO HOME^%ZIS
- +4 SET TVAR(1,0)="0,0,1,2:2,1^Insufficient 2507 Exam Report"
- +5 DO WR^DVBAUTL4("TVAR")
- +6 KILL TVAR
- +7 ;priority of exam selection
- SET DVBAPRTY=$$EXMPRTY^DVBCIUTL("Select Priority of Exam for the Insufficient Exam Report")
- +8 SET RPTTYPE=$SELECT((DVBAPRTY?.A)&(DVBAPRTY]""):$$RPTTYPE^DVBCUTA1(),1:"")
- +9 if ((RPTTYPE'="D")&(RPTTYPE'="S"))
- SET DVBAOUT=""
- +10 if '$DATA(DVBAOUT)
- WRITE !!
- +11 if '$DATA(DVBAOUT)
- DO DATE^DVBCUTL4(.BEGDT,.ENDDT)
- +12 IF $DATA(ENDDT)
- IF (+ENDDT>0)
- Begin DoDot:2
- +13 SET ENDDT=ENDDT_".2359"
- +14 IF RPTTYPE="S"
- Begin DoDot:3
- +15 DO DEVSEL
- +16 IF POP
- DO SUMKILL
- +17 IF 'POP
- Begin DoDot:4
- +18 IF $DATA(IO("Q"))
- Begin DoDot:5
- +19 NEW DVBAI
- +20 SET ZTRTN="SUM^DVBCIRPT"
- SET ZTIO=ION
- +21 SET ZTDESC="Summary Insufficient Exam Report"
- +22 FOR DVBAI="BEGDT","ENDDT","DVBAPRTY"
- SET ZTSAVE(DVBAI)=""
- +23 DO ^%ZTLOAD
- +24 NEW TSK
- SET TSK=$SELECT($DATA(ZTSK)=0:"C",1:"Y")
- +25 IF TSK="Y"
- WRITE !!,"Summary Report Queued. Task number: ",ZTSK
- +26 KILL ZTSK
- DO CONTMES^DVBCUTL4
- +27 DO SUMKILL
- End DoDot:5
- +28 IF '$DATA(IO("Q"))
- DO SUM
- End DoDot:4
- +29 DO ^%ZISC
- End DoDot:3
- +30 IF RPTTYPE="D"
- Begin DoDot:3
- +31 ;**Select the Reasons and Exams to report
- DO DETSEL^DVBCIRP1
- +32 IF '$DATA(DVBAQTSL)
- Begin DoDot:4
- +33 DO DEVSEL
- +34 IF POP
- DO KVARS^DVBCIRP1
- +35 IF 'POP
- Begin DoDot:5
- +36 IF $DATA(IO("Q"))
- Begin DoDot:6
- +37 NEW DVBAI,ZTSAVE
- +38 SET ZTRTN="DETAIL^DVBCIRP1"
- SET ZTIO=ION
- +39 SET ZTDESC="Detailed Insufficient Exam Report"
- +40 FOR DVBAI="BEGDT","ENDDT","DVBAPRTY","DVBAARY(""REASON"",","^TMP($J,""XMTYPE"","
- SET ZTSAVE(DVBAI)=""
- SET ZTSAVE("DVBADLMTR")=0
- +41 DO ^%ZTLOAD
- +42 NEW TSK
- SET TSK=$SELECT($DATA(ZTSK)=0:"C",1:"Y")
- +43 IF TSK="Y"
- WRITE !!,"Detail Report Queued. Task number: ",ZTSK
- +44 KILL ZTSK
- DO CONTMES^DVBCUTL4
- +45 DO KVARS^DVBCIRP1
- End DoDot:6
- +46 IF '$DATA(IO("Q"))
- if IOST?1"C-".E
- WRITE @IOF
- SET DVBADLMTR=0
- DO DETAIL^DVBCIRP1
- End DoDot:5
- +47 DO ^%ZISC
- End DoDot:4
- +48 KILL DVBAQTSL
- End DoDot:3
- +49 DO CLEANUP
- End DoDot:2
- End DoDot:1
- +50 DO KVARS
- +51 QUIT
- +52 ;
- KVARS ;** Kill the variables used in report
- +1 KILL DVBAOUT,ENDDT,BEGDT,DTOUT,DUOUT,RPTTYPE,DVBACAN,DVBASTAT,DVBAPRTY,DVBADLMTR,NUMRPTS
- +2 DO CLEANUP
- +3 QUIT
- +4 ;
- CLEANUP ;** Kill the variables used by the device handler
- +1 KILL %ZIS,POP,%IS,IOP
- +2 KILL IOBS,IOHG,IOPAR,IOUPAR,IOXY,POP,%DT,%YY,%XX,ION,IOPAR
- +3 QUIT
- +4 ;
- 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 NEW DVBAEXMP,DVBAI,DVBAP,DVBATVAR,DVBAMCDES,DVBAPREXM
- +2 USE IO
- +3 SET (DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM)=0
- +4 SET DVBACAN("REQ")=0
- SET DVBACAN("EXM")=0
- +5 SET DVBAENDL=ENDDT
- +6 SET DVBAEXMP=$SELECT(($GET(DVBAPRTY)["BDD"):";BDD;QS;",($GET(DVBAPRTY)["IDES"):";IDES;",($GET(DVBAPRTY)["AO"):";AO;",1:"")
- +7 ; S DVBAMCDES=((DVBAEXMP]"")&(DVBAPRTY'="AO"))
- +8 SET NUMRPTS=$LENGTH(DVBAEXMP,";")
- +9 SET DVBAMCDES=((DVBAEXMP]"")&(NUMRPTS>3))
- +10 ;for multiple priority reporting
- KILL ^TMP("DVBATOTALS",$JOB)
- +11 ;
- +12 ;** Initialize reason counter array(s)
- +13 FOR DVBARIFN=0:0
- SET DVBARIFN=$ORDER(^DVB(396.94,DVBARIFN))
- if +DVBARIFN'>0
- QUIT
- Begin DoDot:1
- +14 if (DVBAMCDES)
- Begin DoDot:2
- +15 FOR DVBAP=$PIECE(DVBAEXMP,";",2),$PIECE(DVBAEXMP,";",3)
- Begin DoDot:3
- +16 if DVBAP=""
- QUIT
- +17 SET ^TMP("DVBATOTALS",$JOB,DVBAP,"DVBAINXM",DVBARIFN)=0
- End DoDot:3
- End DoDot:2
- +18 SET DVBAINXM(DVBARIFN)=0
- End DoDot:1
- +19 if (DVBAMCDES)
- Begin DoDot:1
- +20 FOR DVBAP=$PIECE(DVBAEXMP,";",2),$PIECE(DVBAEXMP,";",3)
- Begin DoDot:2
- +21 if DVBAP=""
- QUIT
- +22 SET ^TMP("DVBATOTALS",$JOB,DVBAP,"DVBAINXM","NO REASON")=0
- End DoDot:2
- End DoDot:1
- +23 SET DVBAINXM("NO REASON")=0
- +24 ;
- +25 ;** Count the total and insufficient number of exams and 2507 requests
- +26 ; For performance, if multiple reports, store totals in single pass of data
- +27 SET DVBADTLP=BEGDT-.0001
- +28 FOR
- SET DVBADTLP=$ORDER(^DVB(396.3,"ADP",DVBADTLP))
- if (DVBADTLP=""!(DVBADTLP>ENDDT))
- QUIT
- Begin DoDot:1
- +29 SET DVBAPRIO=""
- +30 FOR
- SET DVBAPRIO=$ORDER(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO))
- if DVBAPRIO=""
- QUIT
- Begin DoDot:2
- +31 SET DVBADALP=""
- +32 FOR
- SET DVBADALP=$ORDER(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO,DVBADALP))
- if DVBADALP=""
- QUIT
- Begin DoDot:3
- +33 ;check for Parent Request (retrieve current/parent Priority of Exam)
- +34 SET DVBAPREXM=$$CHKREQ^DVBCIRP1(DVBADALP)
- +35 ;original report run (Exclude new priorities)
- +36 if ((DVBAEXMP']"")&((";BDD;QS;IDES;AO;")[(";"_DVBAPREXM_";")))
- QUIT
- +37 ;report for specific Priority of Exam
- +38 if ((DVBAEXMP]"")&(DVBAEXMP'[(";"_DVBAPREXM_";")))
- QUIT
- +39 if (DVBAMCDES)
- SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBARQCT")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBARQCT"))+1
- +40 SET DVBARQCT=DVBARQCT+1
- +41 KILL DVBAINSF
- +42 IF DVBAPRIO="E"
- Begin DoDot:4
- +43 if (DVBAMCDES)
- SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINRQ")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINRQ"))+1
- +44 SET DVBAINRQ=DVBAINRQ+1
- +45 ; ;AJF;Request Status conversion
- +46 IF $PIECE(^DVB(396.3,DVBADALP,0),U,18)=7
- Begin DoDot:5
- +47 if (DVBAMCDES)
- SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANREQ")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANREQ"))+1
- +48 SET DVBACAN("REQ")=DVBACAN("REQ")+1
- End DoDot:5
- +49 SET DVBAINSF=""
- End DoDot:4
- +50 SET DVBAXMDA=""
- +51 FOR
- SET DVBAXMDA=$ORDER(^DVB(396.4,"C",DVBADALP,DVBAXMDA))
- if DVBAXMDA=""
- QUIT
- Begin DoDot:4
- +52 if (DVBAMCDES)
- SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAXMCT")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAXMCT"))+1
- +53 SET DVBAXMCT=DVBAXMCT+1
- +54 IF $DATA(DVBAINSF)
- Begin DoDot:5
- +55 if (DVBAMCDES)
- SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM"))+1
- +56 SET DVBAINXM=DVBAINXM+1
- +57 SET DVBARIFN=$PIECE(^DVB(396.4,DVBAXMDA,0),U,11)
- SET DVBASTAT=$PIECE(^(0),U,4)
- +58 if DVBARIFN=""
- SET DVBARIFN="NO REASON"
- +59 if (DVBAMCDES)
- SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM",DVBARIFN)=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBAINXM",DVBARIFN))+1
- +60 SET DVBAINXM(DVBARIFN)=DVBAINXM(DVBARIFN)+1
- +61 IF DVBASTAT="RX"
- Begin DoDot:6
- +62 if (DVBAMCDES)
- SET ^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANEXM")=$GET(^TMP("DVBATOTALS",$JOB,DVBAPREXM,"DVBACANEXM"))+1
- +63 SET DVBACAN("EXM")=DVBACAN("EXM")+1
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +64 ;
- +65 SET DVBAEXMP=$SELECT(($GET(DVBAPRTY)["BDD"):"BDD,QS",($GET(DVBAPRTY)["IDES"):"IDES",($GET(DVBAPRTY)["AO"):"AO",1:"")
- +66 FOR DVBAI=1:1:$LENGTH(DVBAEXMP,",")
- Begin DoDot:1
- +67 ;priority to report on
- SET DVBAPRTY=$PIECE(DVBAEXMP,",",DVBAI)
- +68 ;Form Feed between multiple Reports
- if (DVBAI>1)
- Begin DoDot:2
- +69 SET DVBATVAR(1,0)="0,0,0,0,1^"
- +70 DO WR^DVBAUTL4("DVBATVAR")
- End DoDot:2
- +71 ;
- +72 ;reset var cntrs for specific priority
- if (DVBAMCDES)
- Begin DoDot:2
- +73 SET DVBARQCT=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBARQCT"))
- +74 SET DVBAINRQ=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINRQ"))
- +75 SET DVBACAN("REQ")=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBACANREQ"))
- +76 SET DVBAXMCT=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAXMCT"))
- +77 SET DVBAINXM=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINXM"))
- +78 SET DVBAP=0
- FOR
- SET DVBAP=$ORDER(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINXM",DVBAP))
- if DVBAP=""
- QUIT
- Begin DoDot:3
- +79 SET DVBAINXM(DVBAP)=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBAINXM",DVBAP))
- End DoDot:3
- +80 SET DVBACAN("EXM")=+$GET(^TMP("DVBATOTALS",$JOB,DVBAPRTY,"DVBACANEXM"))
- End DoDot:2
- +81 ;
- +82 ;print SUMMARY report
- DO SUMRPT^DVBCIRP1
- End DoDot:1
- +83 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +84 DO SUMKILL
- +85 DO ^%ZISC
- +86 QUIT
- +87 ;
- 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
