- 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 Feb 18, 2025@23:55:15 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