ONCTIME ;Hines OIFO/GWB [Timeliness report] ;11/01/10
;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
;
TIME ;[Timeliness report]
K ^TMP("ONC",$J)
N DIC,SDT,EDT,IEN,CNT,LESCNT,GTRCNT,RPTDATE,DIVISION,ACO
N COC,NCRPT,BY,DHD,FLDS,FR,L,TO,DIRUT,EMTC,END,START,TIMEPCT,Y
W @IOF
W !?3,"Timeliness report",!
S %DT="AEX",%DT("A")=" Start Date of First Contact: "
D ^%DT K %DT
Q:Y<1 S START=Y,SDT=Y-1
S %DT="AEX",%DT("A")=" End Date of First Contact..: "
D ^%DT K %DT
Q:Y<1 S (END,EDT)=Y
W !
K DIR
S DIR("A")=" Analytic cases only"
S DIR("B")="YES"
S DIR(0)="Y"
S DIR("?")=" "
S DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 0-2) counted."
S DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) counted."
D ^DIR
I $D(DIRUT) S OUT=1 Q
S ACO=Y
W !
K DIR
S DIR("A")=" Do you want to print a list of non-compliant cases"
S DIR("B")="YES"
S DIR(0)="Y"
S DIR("?")=" "
S DIR("?",1)=" Answer 'YES' if you want to include a list of non-compliant cases."
S DIR("?",2)=" Answer 'NO' if you want to only want the Timeliness Report."
D ^DIR
I $D(DIRUT) S OUT=1 Q
S NCRPT=Y
W !
N %ZIS,IOP,POP
S %ZIS="MQ"
D ^%ZIS Q:$G(POP)
I $D(IO("Q")) D TASK G EXIT
U IO D COMP D ^%ZISC K %ZIS,IOP G EXIT
;
COMP S (CNT,LESCNT,GTRCNT)=0
F S SDT=$O(^ONCO(165.5,"AFC",SDT)) Q:(SDT="")!(SDT>EDT) S IEN=0 F S IEN=$O(^ONCO(165.5,"AFC",SDT,IEN)) Q:IEN="" I $$DIV^ONCFUNC(IEN)=DUZ(2) D
.S COC=$E($$GET1^DIQ(165.5,IEN,.04),1,2)
.I ACO=1,COC>22 Q
.;S EMTC=$$GET1^DIQ(165.5,IEN,157.1)
.S EMTC=$$GET1^DIQ(165.5,IEN,157) ;P5
.I (EMTC["Unknown")!(EMTC["NA") Q
.S CNT=CNT+1
.I EMTC<184 S LESCNT=LESCNT+1
.I EMTC>183 S GTRCNT=GTRCNT+1 S ^TMP("ONC",$J,IEN)=""
I CNT=0 D D:$E(IOST,1,2)="C-" PAUSE^ONCOPA2A G EXIT
.W !,?3,"No cases found in this date range.",!
S TIMEPCT=LESCNT/CNT
S TIMEPCT=$J(TIMEPCT,3,2)*100_"%"
S Y=DT D DD^%DT S RPTDATE=Y
S DIVISION=$P(^DIC(4,DUZ(2),0),U,1)
S Y=START D DD^%DT S START=Y
S Y=END D DD^%DT S END=Y
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 183 days...: ",LESCNT ;p5 change months to days
W !?3,"Cases Completed > 183 days........: ",GTRCNT
W !?3,"Pct of 'Completed' cases compliant: ",TIMEPCT
I $E(IOST,1,2)="C-" W ! D PAUSE^ONCOPA2A
I $G(NCRPT)=0 G CLOSE
W @IOF
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;C36"
S BY="90"
S BY(0)="^TMP(""ONC"",$J,"
S (FR,TO)=""
S DHD="TIMELINESS NON-COMPLIANCE REPORT"
S IOP=ION
D EN1^DIP
CLOSE D ^%ZISC
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("ONC",$J)
Q
;
CLEANUP ;Cleanup
K OUT,ZTDESC,ZTREQ,ZTRTN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCTIME 3286 printed Oct 16, 2024@18:29:38 Page 2
ONCTIME ;Hines OIFO/GWB [Timeliness report] ;11/01/10
+1 ;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
+2 ;
TIME ;[Timeliness report]
+1 KILL ^TMP("ONC",$JOB)
+2 NEW DIC,SDT,EDT,IEN,CNT,LESCNT,GTRCNT,RPTDATE,DIVISION,ACO
+3 NEW COC,NCRPT,BY,DHD,FLDS,FR,L,TO,DIRUT,EMTC,END,START,TIMEPCT,Y
+4 WRITE @IOF
+5 WRITE !?3,"Timeliness report",!
+6 SET %DT="AEX"
SET %DT("A")=" Start Date of First Contact: "
+7 DO ^%DT
KILL %DT
+8 if Y<1
QUIT
SET START=Y
SET SDT=Y-1
+9 SET %DT="AEX"
SET %DT("A")=" End Date of First Contact..: "
+10 DO ^%DT
KILL %DT
+11 if Y<1
QUIT
SET (END,EDT)=Y
+12 WRITE !
+13 KILL DIR
+14 SET DIR("A")=" Analytic cases only"
+15 SET DIR("B")="YES"
+16 SET DIR(0)="Y"
+17 SET DIR("?")=" "
+18 SET DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 0-2) counted."
+19 SET DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) counted."
+20 DO ^DIR
+21 IF $DATA(DIRUT)
SET OUT=1
QUIT
+22 SET ACO=Y
+23 WRITE !
+24 KILL DIR
+25 SET DIR("A")=" Do you want to print a list of non-compliant cases"
+26 SET DIR("B")="YES"
+27 SET DIR(0)="Y"
+28 SET DIR("?")=" "
+29 SET DIR("?",1)=" Answer 'YES' if you want to include a list of non-compliant cases."
+30 SET DIR("?",2)=" Answer 'NO' if you want to only want the Timeliness Report."
+31 DO ^DIR
+32 IF $DATA(DIRUT)
SET OUT=1
QUIT
+33 SET NCRPT=Y
+34 WRITE !
+35 NEW %ZIS,IOP,POP
+36 SET %ZIS="MQ"
+37 DO ^%ZIS
if $GET(POP)
QUIT
+38 IF $DATA(IO("Q"))
DO TASK
GOTO EXIT
+39 USE IO
DO COMP
DO ^%ZISC
KILL %ZIS,IOP
GOTO EXIT
+40 ;
COMP SET (CNT,LESCNT,GTRCNT)=0
+1 FOR
SET SDT=$ORDER(^ONCO(165.5,"AFC",SDT))
if (SDT="")!(SDT>EDT)
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"AFC",SDT,IEN))
if IEN=""
QUIT
IF $$DIV^ONCFUNC(IEN)=DUZ(2)
Begin DoDot:1
+2 SET COC=$EXTRACT($$GET1^DIQ(165.5,IEN,.04),1,2)
+3 IF ACO=1
IF COC>22
QUIT
+4 ;S EMTC=$$GET1^DIQ(165.5,IEN,157.1)
+5 ;P5
SET EMTC=$$GET1^DIQ(165.5,IEN,157)
+6 IF (EMTC["Unknown")!(EMTC["NA")
QUIT
+7 SET CNT=CNT+1
+8 IF EMTC<184
SET LESCNT=LESCNT+1
+9 IF EMTC>183
SET GTRCNT=GTRCNT+1
SET ^TMP("ONC",$JOB,IEN)=""
End DoDot:1
+10 IF CNT=0
Begin DoDot:1
+11 WRITE !,?3,"No cases found in this date range.",!
End DoDot:1
if $EXTRACT(IOST,1,2)="C-"
DO PAUSE^ONCOPA2A
GOTO EXIT
+12 SET TIMEPCT=LESCNT/CNT
+13 SET TIMEPCT=$JUSTIFY(TIMEPCT,3,2)*100_"%"
+14 SET Y=DT
DO DD^%DT
SET RPTDATE=Y
+15 SET DIVISION=$PIECE(^DIC(4,DUZ(2),0),U,1)
+16 SET Y=START
DO DD^%DT
SET START=Y
+17 SET Y=END
DO DD^%DT
SET END=Y
+18 WRITE !
+19 WRITE !?3,"TIMELINESS REPORT",?60,RPTDATE
+20 WRITE !
+21 WRITE !?3,"Start Date of First Contact.......: ",START
+22 WRITE !?3,"End Date of First Contact.........: ",END
+23 WRITE !?3,"Division..........................: ",DIVISION
+24 WRITE !?3,"Analytic cases only...............: ",$SELECT(ACO=1:"YES",1:"NO")
+25 ;p5 change months to days
WRITE !?3,"Cases Completed within 183 days...: ",LESCNT
+26 WRITE !?3,"Cases Completed > 183 days........: ",GTRCNT
+27 WRITE !?3,"Pct of 'Completed' cases compliant: ",TIMEPCT
+28 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
DO PAUSE^ONCOPA2A
+29 IF $GET(NCRPT)=0
GOTO CLOSE
+30 WRITE @IOF
+31 SET DIC="^ONCO(165.5,"
SET L=0
SET L(0)=1
+32 SET FLDS="!61;C2;L5,155;C10;L10;""FIRST CONTACT"",90;C23;L10;""COMPLETED"",157;C36"
+33 SET BY="90"
+34 SET BY(0)="^TMP(""ONC"",$J,"
+35 SET (FR,TO)=""
+36 SET DHD="TIMELINESS NON-COMPLIANCE REPORT"
+37 SET IOP=ION
+38 DO EN1^DIP
CLOSE DO ^%ZISC
+1 QUIT
+2 ;
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("ONC",$JOB)
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL OUT,ZTDESC,ZTREQ,ZTRTN
