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

ONCSRVTM.m

Go to the documentation of this file.
  1. ONCSRVTM ;Hines OIFO/RVD - SERVER ROUTINE FOR TIMELINESS REPORTS ; 05/16/13
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;
  1. TIME ;[Timeliness report server]
  1. K ^TMP($J,"ONCSRV"),^TMP($J,"ONCSRV1"),^TMP($J,"ONCPRT")
  1. N DIC,SDT,EDT,IEN,ONCCNT,ONCLES,ONCMOR,RPTDATE,DIVISION,ACO,ONCDIV,ONCDVCNT
  1. N COC,NCRPT,EMTC,END,START,TIMEPCT,Y,ONCLM,ONCII,ONCJJ
  1. S START=$P(XMRGONC1,"*",2),END=$P(XMRGONC1,"*",3),ACO=$S($P(XMRGONC1,"*",4)="YES":1,1:0)
  1. S NCRPT=$S($P(XMRGONC1,"*",5)="YES":1,1:0)
  1. S Y=DT D DD^%DT S RPTDATE=Y
  1. S X=START D ^%DT S ONCSTART=Y
  1. S X=END D ^%DT S ONCEND=Y
  1. ;
  1. COMP S (ONCCNT,ONCLES,ONCMOR)=0,SDT=ONCSTART-1
  1. N ONCMON,ONCPID
  1. F S SDT=$O(^ONCO(165.5,"AFC",SDT)) Q:(SDT="")!(SDT>ONCEND) S IEN=0 F S IEN=$O(^ONCO(165.5,"AFC",SDT,IEN)) Q:IEN'>0 D
  1. .S ONCDIV=$P(^DIC(4,$$DIV^ONCFUNC(IEN),0),U,1)
  1. .S ONCPID=$$GET1^DIQ(165.5,IEN,61)
  1. .S ONCMON=$$GET1^DIQ(165.5,IEN,157.1)
  1. .S COC=$E($$GET1^DIQ(165.5,IEN,.04),1,2)
  1. .S (ONCDT1,X)=$$GET1^DIQ(165.5,IEN,155) D ^%DT S ONC1CT=Y
  1. .S (ONCDTC,X)=$$GET1^DIQ(165.5,IEN,90) D ^%DT S ONCCPLT=Y
  1. .S ^TMP($J,"ONCSRV",ONCDIV)=""
  1. .I ACO=1,COC>22 Q
  1. .S EMTC=$$GET1^DIQ(165.5,IEN,157.1)
  1. .I (EMTC["Unknown")!(EMTC["NA") Q
  1. .S ONCCNT=ONCCNT+1
  1. .I EMTC<7 D
  1. ..I '$D(^TMP($J,"ONCSRV1",ONCDIV,"LES")) S ^TMP($J,"ONCSRV1",ONCDIV,"LES")=0
  1. ..S ^TMP($J,"ONCSRV1",ONCDIV,"LES")=^TMP($J,"ONCSRV1",ONCDIV,"LES")+1
  1. .I EMTC>6 D
  1. ..I '$D(^TMP($J,"ONCSRV1",ONCDIV,"MOR")) S ^TMP($J,"ONCSRV1",ONCDIV,"MOR")=0
  1. ..S ^TMP($J,"ONCSRV1",ONCDIV,"MOR")=^TMP($J,"ONCSRV1",ONCDIV,"MOR")+1
  1. ..S ^TMP($J,"ONCSRV",ONCDIV,ONCCPLT,IEN)=ONCPID_" "_ONCDT1_" "_ONCDTC_" "_ONCMON
  1. .I '$D(^TMP($J,"ONCSRV1",ONCDIV,"CNT")) S ^TMP($J,"ONCSRV1",ONCDIV,"CNT")=0
  1. .S ^TMP($J,"ONCSRV1",ONCDIV,"CNT")=^TMP($J,"ONCSRV1",ONCDIV,"CNT")+1
  1. S I=0
  1. ;S ^TMP($J,"ONCPRT",0)=""
  1. I ONCCNT=0,'$D(^TMP($J,"ONCSRV1","NOCASE")) S ^TMP($J,"ONCPRT",I+1)="No cases found." D MAIL G EXIT
  1. ;
  1. ;initialize variables
  1. S (ONCD,ONCDIV,ONCOLDV)=""
  1. F S ONCDIV=$O(^TMP($J,"ONCSRV",ONCDIV)) D:ONCDIV'=ONCOLDV TOT Q:ONCDIV="" S (ONCDVCNT,LESCNT,GTRCNT)=0 D HEAD D
  1. .Q:NCRPT=0
  1. .S ONCOLDV=ONCDIV
  1. .F ONCII=0:0 S ONCII=$O(^TMP($J,"ONCSRV",ONCDIV,ONCII)) Q:ONCII'>0 D
  1. ..F ONCJJ=0:0 S ONCJJ=$O(^TMP($J,"ONCSRV",ONCDIV,ONCII,ONCJJ)) Q:ONCJJ'>0 S ONCD=$G(^(ONCJJ)) D
  1. ...S I=I+1
  1. ...S ^TMP($J,"ONCPRT",I)=ONCD
  1. ...S ONCDVCNT=ONCDVCNT+1
  1. D MAIL
  1. G EXIT
  1. Q
  1. ;
  1. TOT ;total of each Division
  1. Q:ONCOLDV=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="COUNT = "_ONCDVCNT
  1. S ONCDVCNT=0
  1. Q
  1. ;
  1. Q:'$D(^TMP($J,"ONCSRV1",ONCDIV,"CNT"))
  1. S (ONCLESS,ONCMORE)=0
  1. S:$D(^TMP($J,"ONCSRV1",ONCDIV,"LES")) ONCLESS=$G(^TMP($J,"ONCSRV1",ONCDIV,"LES"))
  1. S:$D(^TMP($J,"ONCSRV1",ONCDIV,"MOR")) ONCMORE=$G(^TMP($J,"ONCSRV1",ONCDIV,"MOR"))
  1. S I=I+1
  1. S ONCTPCT=""
  1. I $D(^TMP($J,"ONCSRV1",ONCDIV,"LES"))&($D(^TMP($J,"ONCSRV1",ONCDIV,"CNT"))) D
  1. .S ONCTPCT=^TMP($J,"ONCSRV1",ONCDIV,"LES")/^TMP($J,"ONCSRV1",ONCDIV,"CNT")
  1. .S ONCTPCT=$J(ONCTPCT,3,2)*100_"%"
  1. S ^TMP($J,"ONCPRT",I)="",I=I+1
  1. S ^TMP($J,"ONCPRT",I)="TIMELINESS NON-COMPLIANCE REPORT for: "_ONCDIV_" RUN DATE: "_RPTDATE
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="Start Date of First Contact.......: "_START
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="End Date of First Contact.........: "_END
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="Division..........................: "_ONCDIV
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="Analytic cases only...............: "_$S(ACO=1:"YES",1:"NO")
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="Cases Completed within six months.: "_ONCLESS
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="Cases Completed > six months......: "_ONCMORE
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="Pct of 'Completed' cases compliant: "_ONCTPCT
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)=""
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="",I=I+1
  1. Q:NCRPT=0
  1. S ^TMP($J,"ONCPRT",I)="PID# FIRST CONTACT COMPLETED ELAPSED MONTHS TO COMPLETION"
  1. S I=I+1
  1. S ^TMP($J,"ONCPRT",I)="---- ------------- --------- ----------------------------",I=I+1
  1. Q
  1. ;
  1. MAIL ;email report to Oncology
  1. S XMDUZ=.5
  1. D REC^ONCSRV ;get recipients
  1. S XMSUB="Oncology Timeliness Report "_START_" to "_END
  1. S XMTEXT="^TMP($J,""ONCPRT"","
  1. D ^XMD
  1. K XMTEXT
  1. Q
  1. ;
  1. DIV ;process each division
  1. S TIMEPCT=LESCNT/CNT
  1. S TIMEPCT=$J(TIMEPCT,3,2)*100_"%"
  1. S DIVISION=$P(^DIC(4,ONCDIV,0),U,1)
  1. W !
  1. W !?3,"TIMELINESS REPORT",?60,RPTDATE
  1. W !
  1. W !?3,"Start Date of First Contact.......: ",START
  1. W !?3,"End Date of First Contact.........: ",END
  1. W !?3,"Division..........................: ",DIVISION
  1. W !?3,"Analytic cases only...............: ",$S(ACO=1:"YES",1:"NO")
  1. W !?3,"Cases Completed within six months.: ",LESCNT
  1. W !?3,"Cases Completed > six months......: ",GTRCNT
  1. W !?3,"Pct of 'Completed' cases compliant: ",TIMEPCT
  1. I $G(NCRPT)=0 Q
  1. W @IOF
  1. PRT S DIC="^ONCO(165.5,",L=0,L(0)=1
  1. S FLDS="!61;C2;L5,155;C10;L10;""FIRST CONTACT"",90;C23;L10;""COMPLETED"",157.1;C36"
  1. S BY="90"
  1. S BY(0)="^TMP($J,""ONCSRV"",I,"
  1. S (FR,TO)=""
  1. S DHD="TIMELINESS NON-COMPLIANCE REPORT for "_DIVISION
  1. S IOP=ION
  1. D EN1^DIP
  1. Q
  1. ;
  1. TASK ;Queue a task
  1. K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
  1. S ZTRTN="COMP^ONCTIME",ZTREQ="@",ZTSAVE("ZTREQ")=""
  1. S ZTDESC="Timeliness Report"
  1. S ZTSAVE("SDT")="",ZTSAVE("EDT")="",ZTSAVE("START")="",ZTSAVE("END")=""
  1. S ZTSAVE("ACO")=""
  1. S ZTSAVE("NCRPT")=""
  1. D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
  1. K ZTSK
  1. Q
  1. ;
  1. EXIT ;Exit
  1. K ^TMP($J,"ONCSRV"),^TMP($J,"ONCPRT"),^TMP($J,"ONCSRV1")
  1. Q