ONCSRVTM ;Hines OIFO/RVD - SERVER ROUTINE FOR TIMELINESS REPORTS ; 05/16/13
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
TIME ;[Timeliness report server]
K ^TMP($J,"ONCSRV"),^TMP($J,"ONCSRV1"),^TMP($J,"ONCPRT")
N DIC,SDT,EDT,IEN,ONCCNT,ONCLES,ONCMOR,RPTDATE,DIVISION,ACO,ONCDIV,ONCDVCNT
N COC,NCRPT,EMTC,END,START,TIMEPCT,Y,ONCLM,ONCII,ONCJJ
S START=$P(XMRGONC1,"*",2),END=$P(XMRGONC1,"*",3),ACO=$S($P(XMRGONC1,"*",4)="YES":1,1:0)
S NCRPT=$S($P(XMRGONC1,"*",5)="YES":1,1:0)
S Y=DT D DD^%DT S RPTDATE=Y
S X=START D ^%DT S ONCSTART=Y
S X=END D ^%DT S ONCEND=Y
;
COMP S (ONCCNT,ONCLES,ONCMOR)=0,SDT=ONCSTART-1
N ONCMON,ONCPID
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
.S ONCDIV=$P(^DIC(4,$$DIV^ONCFUNC(IEN),0),U,1)
.S ONCPID=$$GET1^DIQ(165.5,IEN,61)
.S ONCMON=$$GET1^DIQ(165.5,IEN,157.1)
.S COC=$E($$GET1^DIQ(165.5,IEN,.04),1,2)
.S (ONCDT1,X)=$$GET1^DIQ(165.5,IEN,155) D ^%DT S ONC1CT=Y
.S (ONCDTC,X)=$$GET1^DIQ(165.5,IEN,90) D ^%DT S ONCCPLT=Y
.S ^TMP($J,"ONCSRV",ONCDIV)=""
.I ACO=1,COC>22 Q
.S EMTC=$$GET1^DIQ(165.5,IEN,157.1)
.I (EMTC["Unknown")!(EMTC["NA") Q
.S ONCCNT=ONCCNT+1
.I EMTC<7 D
..I '$D(^TMP($J,"ONCSRV1",ONCDIV,"LES")) S ^TMP($J,"ONCSRV1",ONCDIV,"LES")=0
..S ^TMP($J,"ONCSRV1",ONCDIV,"LES")=^TMP($J,"ONCSRV1",ONCDIV,"LES")+1
.I EMTC>6 D
..I '$D(^TMP($J,"ONCSRV1",ONCDIV,"MOR")) S ^TMP($J,"ONCSRV1",ONCDIV,"MOR")=0
..S ^TMP($J,"ONCSRV1",ONCDIV,"MOR")=^TMP($J,"ONCSRV1",ONCDIV,"MOR")+1
..S ^TMP($J,"ONCSRV",ONCDIV,ONCCPLT,IEN)=ONCPID_" "_ONCDT1_" "_ONCDTC_" "_ONCMON
.I '$D(^TMP($J,"ONCSRV1",ONCDIV,"CNT")) S ^TMP($J,"ONCSRV1",ONCDIV,"CNT")=0
.S ^TMP($J,"ONCSRV1",ONCDIV,"CNT")=^TMP($J,"ONCSRV1",ONCDIV,"CNT")+1
S I=0
;S ^TMP($J,"ONCPRT",0)=""
I ONCCNT=0,'$D(^TMP($J,"ONCSRV1","NOCASE")) S ^TMP($J,"ONCPRT",I+1)="No cases found." D MAIL G EXIT
;
;initialize variables
S (ONCD,ONCDIV,ONCOLDV)=""
F S ONCDIV=$O(^TMP($J,"ONCSRV",ONCDIV)) D:ONCDIV'=ONCOLDV TOT Q:ONCDIV="" S (ONCDVCNT,LESCNT,GTRCNT)=0 D HEAD D
.Q:NCRPT=0
.S ONCOLDV=ONCDIV
.F ONCII=0:0 S ONCII=$O(^TMP($J,"ONCSRV",ONCDIV,ONCII)) Q:ONCII'>0 D
..F ONCJJ=0:0 S ONCJJ=$O(^TMP($J,"ONCSRV",ONCDIV,ONCII,ONCJJ)) Q:ONCJJ'>0 S ONCD=$G(^(ONCJJ)) D
...S I=I+1
...S ^TMP($J,"ONCPRT",I)=ONCD
...S ONCDVCNT=ONCDVCNT+1
D MAIL
G EXIT
Q
;
TOT ;total of each Division
Q:ONCOLDV=""
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="COUNT = "_ONCDVCNT
S ONCDVCNT=0
Q
;
HEAD ;print header
Q:'$D(^TMP($J,"ONCSRV1",ONCDIV,"CNT"))
S (ONCLESS,ONCMORE)=0
S:$D(^TMP($J,"ONCSRV1",ONCDIV,"LES")) ONCLESS=$G(^TMP($J,"ONCSRV1",ONCDIV,"LES"))
S:$D(^TMP($J,"ONCSRV1",ONCDIV,"MOR")) ONCMORE=$G(^TMP($J,"ONCSRV1",ONCDIV,"MOR"))
S I=I+1
S ONCTPCT=""
I $D(^TMP($J,"ONCSRV1",ONCDIV,"LES"))&($D(^TMP($J,"ONCSRV1",ONCDIV,"CNT"))) D
.S ONCTPCT=^TMP($J,"ONCSRV1",ONCDIV,"LES")/^TMP($J,"ONCSRV1",ONCDIV,"CNT")
.S ONCTPCT=$J(ONCTPCT,3,2)*100_"%"
S ^TMP($J,"ONCPRT",I)="",I=I+1
S ^TMP($J,"ONCPRT",I)="TIMELINESS NON-COMPLIANCE REPORT for: "_ONCDIV_" RUN DATE: "_RPTDATE
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="Start Date of First Contact.......: "_START
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="End Date of First Contact.........: "_END
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="Division..........................: "_ONCDIV
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="Analytic cases only...............: "_$S(ACO=1:"YES",1:"NO")
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="Cases Completed within six months.: "_ONCLESS
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="Cases Completed > six months......: "_ONCMORE
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="Pct of 'Completed' cases compliant: "_ONCTPCT
S I=I+1
S ^TMP($J,"ONCPRT",I)=""
S I=I+1
S ^TMP($J,"ONCPRT",I)="",I=I+1
Q:NCRPT=0
S ^TMP($J,"ONCPRT",I)="PID# FIRST CONTACT COMPLETED ELAPSED MONTHS TO COMPLETION"
S I=I+1
S ^TMP($J,"ONCPRT",I)="---- ------------- --------- ----------------------------",I=I+1
Q
;
MAIL ;email report to Oncology
S XMDUZ=.5
D REC^ONCSRV ;get recipients
S XMSUB="Oncology Timeliness Report "_START_" to "_END
S XMTEXT="^TMP($J,""ONCPRT"","
D ^XMD
K XMTEXT
Q
;
DIV ;process each division
S TIMEPCT=LESCNT/CNT
S TIMEPCT=$J(TIMEPCT,3,2)*100_"%"
S DIVISION=$P(^DIC(4,ONCDIV,0),U,1)
W !
W !?3,"TIMELINESS REPORT",?60,RPTDATE
W !
W !?3,"Start Date of First Contact.......: ",START
W !?3,"End Date of First Contact.........: ",END
W !?3,"Division..........................: ",DIVISION
W !?3,"Analytic cases only...............: ",$S(ACO=1:"YES",1:"NO")
W !?3,"Cases Completed within six months.: ",LESCNT
W !?3,"Cases Completed > six months......: ",GTRCNT
W !?3,"Pct of 'Completed' cases compliant: ",TIMEPCT
I $G(NCRPT)=0 Q
W @IOF
PRT S DIC="^ONCO(165.5,",L=0,L(0)=1
S FLDS="!61;C2;L5,155;C10;L10;""FIRST CONTACT"",90;C23;L10;""COMPLETED"",157.1;C36"
S BY="90"
S BY(0)="^TMP($J,""ONCSRV"",I,"
S (FR,TO)=""
S DHD="TIMELINESS NON-COMPLIANCE REPORT for "_DIVISION
S IOP=ION
D EN1^DIP
Q
;
TASK ;Queue a task
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
S ZTRTN="COMP^ONCTIME",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTDESC="Timeliness Report"
S ZTSAVE("SDT")="",ZTSAVE("EDT")="",ZTSAVE("START")="",ZTSAVE("END")=""
S ZTSAVE("ACO")=""
S ZTSAVE("NCRPT")=""
D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
K ZTSK
Q
;
EXIT ;Exit
K ^TMP($J,"ONCSRV"),^TMP($J,"ONCPRT"),^TMP($J,"ONCSRV1")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSRVTM 5816 printed Sep 23, 2025@20:04:53 Page 2
ONCSRVTM ;Hines OIFO/RVD - SERVER ROUTINE FOR TIMELINESS REPORTS ; 05/16/13
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
TIME ;[Timeliness report server]
+1 KILL ^TMP($JOB,"ONCSRV"),^TMP($JOB,"ONCSRV1"),^TMP($JOB,"ONCPRT")
+2 NEW DIC,SDT,EDT,IEN,ONCCNT,ONCLES,ONCMOR,RPTDATE,DIVISION,ACO,ONCDIV,ONCDVCNT
+3 NEW COC,NCRPT,EMTC,END,START,TIMEPCT,Y,ONCLM,ONCII,ONCJJ
+4 SET START=$PIECE(XMRGONC1,"*",2)
SET END=$PIECE(XMRGONC1,"*",3)
SET ACO=$SELECT($PIECE(XMRGONC1,"*",4)="YES":1,1:0)
+5 SET NCRPT=$SELECT($PIECE(XMRGONC1,"*",5)="YES":1,1:0)
+6 SET Y=DT
DO DD^%DT
SET RPTDATE=Y
+7 SET X=START
DO ^%DT
SET ONCSTART=Y
+8 SET X=END
DO ^%DT
SET ONCEND=Y
+9 ;
COMP SET (ONCCNT,ONCLES,ONCMOR)=0
SET SDT=ONCSTART-1
+1 NEW ONCMON,ONCPID
+2 FOR
SET SDT=$ORDER(^ONCO(165.5,"AFC",SDT))
if (SDT="")!(SDT>ONCEND)
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"AFC",SDT,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET ONCDIV=$PIECE(^DIC(4,$$DIV^ONCFUNC(IEN),0),U,1)
+4 SET ONCPID=$$GET1^DIQ(165.5,IEN,61)
+5 SET ONCMON=$$GET1^DIQ(165.5,IEN,157.1)
+6 SET COC=$EXTRACT($$GET1^DIQ(165.5,IEN,.04),1,2)
+7 SET (ONCDT1,X)=$$GET1^DIQ(165.5,IEN,155)
DO ^%DT
SET ONC1CT=Y
+8 SET (ONCDTC,X)=$$GET1^DIQ(165.5,IEN,90)
DO ^%DT
SET ONCCPLT=Y
+9 SET ^TMP($JOB,"ONCSRV",ONCDIV)=""
+10 IF ACO=1
IF COC>22
QUIT
+11 SET EMTC=$$GET1^DIQ(165.5,IEN,157.1)
+12 IF (EMTC["Unknown")!(EMTC["NA")
QUIT
+13 SET ONCCNT=ONCCNT+1
+14 IF EMTC<7
Begin DoDot:2
+15 IF '$DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"LES"))
SET ^TMP($JOB,"ONCSRV1",ONCDIV,"LES")=0
+16 SET ^TMP($JOB,"ONCSRV1",ONCDIV,"LES")=^TMP($JOB,"ONCSRV1",ONCDIV,"LES")+1
End DoDot:2
+17 IF EMTC>6
Begin DoDot:2
+18 IF '$DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"MOR"))
SET ^TMP($JOB,"ONCSRV1",ONCDIV,"MOR")=0
+19 SET ^TMP($JOB,"ONCSRV1",ONCDIV,"MOR")=^TMP($JOB,"ONCSRV1",ONCDIV,"MOR")+1
+20 SET ^TMP($JOB,"ONCSRV",ONCDIV,ONCCPLT,IEN)=ONCPID_" "_ONCDT1_" "_ONCDTC_" "_ONCMON
End DoDot:2
+21 IF '$DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"CNT"))
SET ^TMP($JOB,"ONCSRV1",ONCDIV,"CNT")=0
+22 SET ^TMP($JOB,"ONCSRV1",ONCDIV,"CNT")=^TMP($JOB,"ONCSRV1",ONCDIV,"CNT")+1
End DoDot:1
+23 SET I=0
+24 ;S ^TMP($J,"ONCPRT",0)=""
+25 IF ONCCNT=0
IF '$DATA(^TMP($JOB,"ONCSRV1","NOCASE"))
SET ^TMP($JOB,"ONCPRT",I+1)="No cases found."
DO MAIL
GOTO EXIT
+26 ;
+27 ;initialize variables
+28 SET (ONCD,ONCDIV,ONCOLDV)=""
+29 FOR
SET ONCDIV=$ORDER(^TMP($JOB,"ONCSRV",ONCDIV))
if ONCDIV'=ONCOLDV
DO TOT
if ONCDIV=""
QUIT
SET (ONCDVCNT,LESCNT,GTRCNT)=0
DO HEAD
Begin DoDot:1
+30 if NCRPT=0
QUIT
+31 SET ONCOLDV=ONCDIV
+32 FOR ONCII=0:0
SET ONCII=$ORDER(^TMP($JOB,"ONCSRV",ONCDIV,ONCII))
if ONCII'>0
QUIT
Begin DoDot:2
+33 FOR ONCJJ=0:0
SET ONCJJ=$ORDER(^TMP($JOB,"ONCSRV",ONCDIV,ONCII,ONCJJ))
if ONCJJ'>0
QUIT
SET ONCD=$GET(^(ONCJJ))
Begin DoDot:3
+34 SET I=I+1
+35 SET ^TMP($JOB,"ONCPRT",I)=ONCD
+36 SET ONCDVCNT=ONCDVCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+37 DO MAIL
+38 GOTO EXIT
+39 QUIT
+40 ;
TOT ;total of each Division
+1 if ONCOLDV=""
QUIT
+2 SET I=I+1
+3 SET ^TMP($JOB,"ONCPRT",I)=""
+4 SET I=I+1
+5 SET ^TMP($JOB,"ONCPRT",I)="COUNT = "_ONCDVCNT
+6 SET ONCDVCNT=0
+7 QUIT
+8 ;
HEAD ;print header
+1 if '$DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"CNT"))
QUIT
+2 SET (ONCLESS,ONCMORE)=0
+3 if $DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"LES"))
SET ONCLESS=$GET(^TMP($JOB,"ONCSRV1",ONCDIV,"LES"))
+4 if $DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"MOR"))
SET ONCMORE=$GET(^TMP($JOB,"ONCSRV1",ONCDIV,"MOR"))
+5 SET I=I+1
+6 SET ONCTPCT=""
+7 IF $DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"LES"))&($DATA(^TMP($JOB,"ONCSRV1",ONCDIV,"CNT")))
Begin DoDot:1
+8 SET ONCTPCT=^TMP($JOB,"ONCSRV1",ONCDIV,"LES")/^TMP($JOB,"ONCSRV1",ONCDIV,"CNT")
+9 SET ONCTPCT=$JUSTIFY(ONCTPCT,3,2)*100_"%"
End DoDot:1
+10 SET ^TMP($JOB,"ONCPRT",I)=""
SET I=I+1
+11 SET ^TMP($JOB,"ONCPRT",I)="TIMELINESS NON-COMPLIANCE REPORT for: "_ONCDIV_" RUN DATE: "_RPTDATE
+12 SET I=I+1
+13 SET ^TMP($JOB,"ONCPRT",I)=""
+14 SET I=I+1
+15 SET ^TMP($JOB,"ONCPRT",I)=""
+16 SET I=I+1
+17 SET ^TMP($JOB,"ONCPRT",I)="Start Date of First Contact.......: "_START
+18 SET I=I+1
+19 SET ^TMP($JOB,"ONCPRT",I)=""
+20 SET I=I+1
+21 SET ^TMP($JOB,"ONCPRT",I)="End Date of First Contact.........: "_END
+22 SET I=I+1
+23 SET ^TMP($JOB,"ONCPRT",I)=""
+24 SET I=I+1
+25 SET ^TMP($JOB,"ONCPRT",I)="Division..........................: "_ONCDIV
+26 SET I=I+1
+27 SET ^TMP($JOB,"ONCPRT",I)=""
+28 SET I=I+1
+29 SET ^TMP($JOB,"ONCPRT",I)="Analytic cases only...............: "_$SELECT(ACO=1:"YES",1:"NO")
+30 SET I=I+1
+31 SET ^TMP($JOB,"ONCPRT",I)=""
+32 SET I=I+1
+33 SET ^TMP($JOB,"ONCPRT",I)="Cases Completed within six months.: "_ONCLESS
+34 SET I=I+1
+35 SET ^TMP($JOB,"ONCPRT",I)=""
+36 SET I=I+1
+37 SET ^TMP($JOB,"ONCPRT",I)="Cases Completed > six months......: "_ONCMORE
+38 SET I=I+1
+39 SET ^TMP($JOB,"ONCPRT",I)=""
+40 SET I=I+1
+41 SET ^TMP($JOB,"ONCPRT",I)="Pct of 'Completed' cases compliant: "_ONCTPCT
+42 SET I=I+1
+43 SET ^TMP($JOB,"ONCPRT",I)=""
+44 SET I=I+1
+45 SET ^TMP($JOB,"ONCPRT",I)=""
SET I=I+1
+46 if NCRPT=0
QUIT
+47 SET ^TMP($JOB,"ONCPRT",I)="PID# FIRST CONTACT COMPLETED ELAPSED MONTHS TO COMPLETION"
+48 SET I=I+1
+49 SET ^TMP($JOB,"ONCPRT",I)="---- ------------- --------- ----------------------------"
SET I=I+1
+50 QUIT
+51 ;
MAIL ;email report to Oncology
+1 SET XMDUZ=.5
+2 ;get recipients
DO REC^ONCSRV
+3 SET XMSUB="Oncology Timeliness Report "_START_" to "_END
+4 SET XMTEXT="^TMP($J,""ONCPRT"","
+5 DO ^XMD
+6 KILL XMTEXT
+7 QUIT
+8 ;
DIV ;process each division
+1 SET TIMEPCT=LESCNT/CNT
+2 SET TIMEPCT=$JUSTIFY(TIMEPCT,3,2)*100_"%"
+3 SET DIVISION=$PIECE(^DIC(4,ONCDIV,0),U,1)
+4 WRITE !
+5 WRITE !?3,"TIMELINESS REPORT",?60,RPTDATE
+6 WRITE !
+7 WRITE !?3,"Start Date of First Contact.......: ",START
+8 WRITE !?3,"End Date of First Contact.........: ",END
+9 WRITE !?3,"Division..........................: ",DIVISION
+10 WRITE !?3,"Analytic cases only...............: ",$SELECT(ACO=1:"YES",1:"NO")
+11 WRITE !?3,"Cases Completed within six months.: ",LESCNT
+12 WRITE !?3,"Cases Completed > six months......: ",GTRCNT
+13 WRITE !?3,"Pct of 'Completed' cases compliant: ",TIMEPCT
+14 IF $GET(NCRPT)=0
QUIT
+15 WRITE @IOF
PRT SET DIC="^ONCO(165.5,"
SET L=0
SET L(0)=1
+1 SET FLDS="!61;C2;L5,155;C10;L10;""FIRST CONTACT"",90;C23;L10;""COMPLETED"",157.1;C36"
+2 SET BY="90"
+3 SET BY(0)="^TMP($J,""ONCSRV"",I,"
+4 SET (FR,TO)=""
+5 SET DHD="TIMELINESS NON-COMPLIANCE REPORT for "_DIVISION
+6 SET IOP=ION
+7 DO EN1^DIP
+8 QUIT
+9 ;
TASK ;Queue a task
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
+2 SET ZTRTN="COMP^ONCTIME"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+3 SET ZTDESC="Timeliness Report"
+4 SET ZTSAVE("SDT")=""
SET ZTSAVE("EDT")=""
SET ZTSAVE("START")=""
SET ZTSAVE("END")=""
+5 SET ZTSAVE("ACO")=""
+6 SET ZTSAVE("NCRPT")=""
+7 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
+8 KILL ZTSK
+9 QUIT
+10 ;
EXIT ;Exit
+1 KILL ^TMP($JOB,"ONCSRV"),^TMP($JOB,"ONCPRT"),^TMP($JOB,"ONCSRV1")
+2 QUIT
