Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBCIRP2

DVBCIRP2.m

Go to the documentation of this file. 
  1. 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
  1.  ;Copied DVBCIRP1 and to remove all Priority of exam filter code for CAPRI only
  1.  ;CAPRI Insufficient Exam Report no longer uses priority of exam filters
  1.  ;no longer uses insufficient reason filters
  1.  ;** Version Changes
  1.  ;   2.7 - New routine (Enhc 1)
  1.  ;
  1. SUMRPT ;**Output the summary report
  1.  W:IOST?1"C-".E @IOF
  1.  D SUMHD
  1.  ;print request data
  1.  W !?3,"Total 2507 requests received for date range:",?71,$J(DVBARQCT,5)
  1.  W !?3,"Total insufficient 2507 requests received for date range:",?71,$J(DVBAINRQ,5)
  1.  W !?3,"Total insufficient 2507 requests cancelled by RO for date range:",?71,$J(DVBACAN("REQ"),5)
  1.  I DVBARQCT>0 D
  1.  .S PERCENT=(DVBAINRQ/DVBARQCT)*100
  1.  .W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
  1.  .S PERCENT=((DVBAINRQ-DVBACAN("REQ"))/DVBARQCT)*100
  1.  .W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
  1.  I DVBARQCT'>0 D
  1.  .S PERCENT=0
  1.  .W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
  1.  .W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
  1.  ;print exam data
  1.  W !!?3,"Total 2507 exams received for date range:",?71,$J(DVBAXMCT,5)
  1.  W !?3,"Total insufficient 2507 exams received for date range:",?71,$J(DVBAINXM,5)
  1.  W !?3,"Total insufficient 2507 exams cancelled by RO for date range:",?71,$J(DVBACAN("EXM"),5)
  1.  I DVBAXMCT>0 D
  1.  .S PERCENT=(DVBAINXM/DVBAXMCT)*100
  1.  .W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
  1.  .S PERCENT=((DVBAINXM-DVBACAN("EXM"))/DVBAXMCT)*100
  1.  .W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
  1.  I DVBAXMCT'>0 D
  1.  .S PERCENT=0
  1.  .W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
  1.  .W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
  1.  ;print insufficient reason data
  1.  I IOST?1"C-".E DO
  1.  .K DTOUT,DUOUT
  1.  .W !!
  1.  .D PAUSE^DVBCUTL4
  1.  .I '$D(DTOUT),('$D(DUOUT)) DO
  1.  ..W @IOF
  1.  ..D SUMHD
  1.  I '$D(DTOUT),('$D(DUOUT)) DO
  1.  .W:IOST'?1"C-".E !!
  1.  .W !?15,"Summary of insufficient exams per Reason",!
  1.  .W !?3,"Reason",?53,"Num",?59,"Percent"
  1.  .N DVBARSLP S DVBARSLP=""
  1.  .F  S DVBARSLP=$O(DVBAINXM(DVBARSLP)) Q:DVBARSLP=""  DO  ;**Reason tot's
  1.  ..W:+DVBARSLP>0 !?3,$P(^DVB(396.94,DVBARSLP,0),U,3),?53,DVBAINXM(DVBARSLP)
  1.  ..I +DVBARSLP'>0,(+DVBAINXM(DVBARSLP)>0) W !?3,"Exams without insufficient reason indicated",?53,DVBAINXM(DVBARSLP)
  1.  ..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:"")_" %"
  1.  .I IOST?1"C-".E DO
  1.  ..D CONTMES^DVBCUTL4
  1.  Q
  1.  ;
  1. SUMHD ;** Output Summary Report heading
  1.  N STRTDT,LSTDT,DVBATXT,DVBASL
  1.  W !?15,"Summary Insufficient Exam Report for ",$$SITE^DVBCUTL4(),!
  1.  S Y=$P(BEGDT,".",1) X ^DD("DD") S STRTDT=Y K Y
  1.  S Y=$P(ENDDT,".",1) X ^DD("DD") S LSTDT=Y K Y
  1.  S DVBASL=$L($$SITE^DVBCUTL4)
  1.  ;S DVBATXT=$$PRHD^DVBCIUTL(DVBAPRTY)
  1.  S DVBATXT=""
  1.  W ?(((67+DVBASL)-$L(DVBATXT))\2)
  1.  W !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
  1.  Q
  1.  ;
  1. DETAIL ;** Output reason, exam type and exam info
  1.  ;RSDA is the reason ien
  1.  ;TPDA is the exam type ien
  1.  ;XMDA is the exam ien from 396.4
  1.  ;DVBARQST is the request ien from 396.3
  1.  N STRTDT,LSTDT,DVBARQST,DVBAEXMP,DVBAP,DVBAPREXM,MSGCNT
  1.  S MSGCNT=0
  1.  K ^TMP("DVBAEXAMS",$J),^TMP("INSUFF",$J)
  1.  S X=$P(BEGDT,".",1),STRTDT=$$FMTE^XLFDT(X,"5DZ")
  1.  S Y=$P(ENDDT,".",1),LSTDT=$$FMTE^XLFDT(Y,"5DZ")
  1.  U IO
  1.  S DVBADTLP=BEGDT
  1.  S DVBAENDL=ENDDT
  1.  S RSDA=""
  1.  S DVBAPG1=""
  1.  F  S RSDA=$O(DVBAARY("REASON",RSDA)) Q:(RSDA=""!($D(GETOUT)))  DO
  1.  .K DVBARSPT
  1.  .S TPDA=""
  1.  .F  S TPDA=$O(^TMP($J,"XMTYPE",TPDA)) Q:(TPDA=""!($D(GETOUT)))  DO
  1.  ..K DVBAXMPT
  1.  ..S XMDA=""
  1.  ..F  S XMDA=$O(^DVB(396.4,"AIT",RSDA,TPDA,XMDA)) Q:(XMDA=""!($D(GETOUT)))  DO
  1.  ...S DVBARQST=$G(^DVB(396.3,$P(^DVB(396.4,XMDA,0),U,2),0))
  1.  ...I $P(DVBARQST,U,5)>DVBADTLP,($P(DVBARQST,U,5)<DVBAENDL) D
  1.  ....S ^TMP("DVBAEXAMS",$J,RSDA,TPDA,XMDA)=""
  1.  S DVBABIEN=DVBARQST
  1.  K DVBAPG1 S RSDA=""
  1.  D CAPDETHD^DVBCIUTL S DVBAPG1=""
  1.  F  S RSDA=$O(^TMP("DVBAEXAMS",$J,RSDA)) Q:(('+RSDA)!($D(GETOUT)))  D
  1.  .K DVBARSPT S TPDA=""
  1.  .F  S TPDA=$O(^TMP("DVBAEXAMS",$J,RSDA,TPDA)) Q:(('+TPDA)!($D(GETOUT)))  D
  1.  ..K DVBAXMPT S XMDA=""
  1.  ..F  S XMDA=$O(^TMP("DVBAEXAMS",$J,RSDA,TPDA,XMDA)) Q:(('+XMDA)!($D(GETOUT)))  D EXMOUT^DVBCIUTL
  1.  I '$D(GETOUT),(IOST?1"C-".E) D CONTMES^DVBCUTL4
  1.  K GETOUT W !
  1.  D ^%ZISC
  1.  D KVARS ;**KILL the variables used by DETAIL
  1.  Q
  1.  ;
  1. KVARS ;** Final Kill for Detail report
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  K ^TMP($J),DVBAARY,DVBANAME,DVBASSN,DVBACNUM,RSDA,TPDA,XMDA,DVBADTLP,DVBAENDL
  1.  Q
  1.  ;
  1.  ;
  1.  ;Input:  IEN of 2507 Request in File #396.3
  1.  ;Output: Priority of Exam for the Current/Parent 2507 Request
  1. CHKREQ(DVBARIEN) ;check for parent requests
  1.  N DVBAPIEN,DVBAPEXM
  1.  Q:($G(DVBARIEN)']"") ""
  1.  S DVBAPEXM=$P($G(^DVB(396.3,DVBARIEN,0)),U,10)  ;Priority of Exam
  1.  S DVBAPIEN=$P($G(^DVB(396.3,DVBARIEN,5)),U)  ;parent IEN if it exists
  1.  I (DVBAPIEN]"") D  ;Parent 2507 Request
  1.  .S DVBAPEXM=$P($G(^DVB(396.3,DVBAPIEN,0)),U,10)  ;Priority of Exam
  1.  Q DVBAPEXM
  1. SUM ;** Set up reason counter array, count all 2507's received
  1.  ;copied from DVBCIRPT 
  1.  N DVBAEXMP,DVBAI,DVBAP,DVBATVAR,DVBAMCDES,DVBAPREXM
  1.  U IO
  1.  S (DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM)=0
  1.  S DVBACAN("REQ")=0,DVBACAN("EXM")=0
  1.  S DVBAENDL=ENDDT
  1.  S DVBAEXMP=$S(($G(DVBAPRTY)["BDD"):";BDD;QS;",($G(DVBAPRTY)["IDES"):";IDES;",($G(DVBAPRTY)["AO"):";AO;",1:"")
  1.  ; S DVBAMCDES=((DVBAEXMP]"")&(DVBAPRTY'="AO"))
  1.  S NUMRPTS=$L(DVBAEXMP,";")
  1.  S DVBAMCDES=((DVBAEXMP]"")&(NUMRPTS>3))
  1.  K ^TMP("DVBATOTALS",$J)  ;for multiple priority reporting
  1.  ;
  1.  ;** Initialize reason counter array(s)
  1.  F DVBARIFN=0:0 S DVBARIFN=$O(^DVB(396.94,DVBARIFN)) Q:+DVBARIFN'>0  DO
  1.  .D:(DVBAMCDES)
  1.  ..F DVBAP=$P(DVBAEXMP,";",2),$P(DVBAEXMP,";",3)  D
  1.  ...Q:DVBAP=""
  1.  ...S ^TMP("DVBATOTALS",$J,DVBAP,"DVBAINXM",DVBARIFN)=0
  1.  .S DVBAINXM(DVBARIFN)=0
  1.  D:(DVBAMCDES)
  1.  .F DVBAP=$P(DVBAEXMP,";",2),$P(DVBAEXMP,";",3)  D
  1.  ..Q:DVBAP=""
  1.  ..S ^TMP("DVBATOTALS",$J,DVBAP,"DVBAINXM","NO REASON")=0
  1.  S DVBAINXM("NO REASON")=0
  1.  ;
  1.  ;** Count the total and insufficient number of exams and 2507 requests
  1.  ;     For performance, if multiple reports, store totals in single pass of data
  1.  S DVBADTLP=BEGDT-.0001
  1.  F  S DVBADTLP=$O(^DVB(396.3,"ADP",DVBADTLP)) Q:(DVBADTLP=""!(DVBADTLP>ENDDT))  DO
  1.  .S DVBAPRIO=""
  1.  .F  S DVBAPRIO=$O(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO)) Q:DVBAPRIO=""  DO
  1.  ..S DVBADALP=""
  1.  ..F  S DVBADALP=$O(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO,DVBADALP)) Q:DVBADALP=""  DO
  1.  ...;check for Parent Request (retrieve current/parent Priority of Exam)
  1.  ...S DVBAPREXM=$$CHKREQ(DVBADALP)
  1.  ...S DVBAPREXM=""
  1.  ...;original report run (Exclude new priorities)
  1.  ...Q:((DVBAEXMP']"")&((";BDD;QS;IDES;AO;")[(";"_DVBAPREXM_";")))
  1.  ...;report for specific Priority of Exam
  1.  ...Q:((DVBAEXMP]"")&(DVBAEXMP'[(";"_DVBAPREXM_";")))
  1.  ...S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBARQCT")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBARQCT"))+1
  1.  ...S DVBARQCT=DVBARQCT+1
  1.  ...K DVBAINSF
  1.  ...I DVBAPRIO="E" DO
  1.  ....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINRQ")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINRQ"))+1
  1.  ....S DVBAINRQ=DVBAINRQ+1
  1.  ....;AJF;Request Status conversion
  1.  ....I $P(^DVB(396.3,DVBADALP,0),U,18)=7 D
  1.  .....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANREQ")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANREQ"))+1
  1.  .....S DVBACAN("REQ")=DVBACAN("REQ")+1
  1.  ....S DVBAINSF=""
  1.  ...S DVBAXMDA=""
  1.  ...F  S DVBAXMDA=$O(^DVB(396.4,"C",DVBADALP,DVBAXMDA)) Q:DVBAXMDA=""  DO
  1.  ....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAXMCT")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAXMCT"))+1
  1.  ....S DVBAXMCT=DVBAXMCT+1
  1.  ....I $D(DVBAINSF) DO
  1.  .....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM"))+1
  1.  .....S DVBAINXM=DVBAINXM+1
  1.  .....S DVBARIFN=$P(^DVB(396.4,DVBAXMDA,0),U,11),DVBASTAT=$P(^(0),U,4)
  1.  .....S:DVBARIFN="" DVBARIFN="NO REASON"
  1.  .....S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM",DVBARIFN)=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBAINXM",DVBARIFN))+1
  1.  .....S DVBAINXM(DVBARIFN)=DVBAINXM(DVBARIFN)+1
  1.  .....I DVBASTAT="RX" D
  1.  ......S:(DVBAMCDES) ^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANEXM")=$G(^TMP("DVBATOTALS",$J,DVBAPREXM,"DVBACANEXM"))+1
  1.  ......S DVBACAN("EXM")=DVBACAN("EXM")+1
  1.  ;
  1.  S DVBAEXMP=$S(($G(DVBAPRTY)["BDD"):"BDD,QS",($G(DVBAPRTY)["IDES"):"IDES",($G(DVBAPRTY)["AO"):"AO",1:"")
  1.  F DVBAI=1:1:$L(DVBAEXMP,",")  D
  1.  .S DVBAPRTY=$P(DVBAEXMP,",",DVBAI)  ;priority to report on
  1.  .D:(DVBAI>1)  ;Form Feed between multiple Reports
  1.  ..S DVBATVAR(1,0)="0,0,0,0,1^"
  1.  ..D WR^DVBAUTL4("DVBATVAR")
  1.  .;
  1.  .D:(DVBAMCDES)  ;reset var cntrs for specific priority
  1.  ..S DVBARQCT=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBARQCT"))
  1.  ..S DVBAINRQ=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINRQ"))
  1.  ..S DVBACAN("REQ")=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBACANREQ"))
  1.  ..S DVBAXMCT=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAXMCT"))
  1.  ..S DVBAINXM=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINXM"))
  1.  ..S DVBAP=0 F  S DVBAP=$O(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINXM",DVBAP)) Q:DVBAP=""  D
  1.  ...S DVBAINXM(DVBAP)=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBAINXM",DVBAP))
  1.  ..S DVBACAN("EXM")=+$G(^TMP("DVBATOTALS",$J,DVBAPRTY,"DVBACANEXM"))
  1.  .;
  1.  .D SUMRPT  ;print SUMMARY report
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  D SUMKILL
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. SUMKILL ;** Kill the variables used in the summary report
  1.  K DVBADTLP,DVBAENDL,DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM
  1.  K DVBAPRIO,DVBADALP,DVBAXMDA,DVBAINSF,DVBARIFN
  1.  K ^TMP("DVBATOTALS",$J)
  1.  Q