ONCTNMC ;Hines OIFO/GWB [TNM Compute percentage of TNM forms completed] ;03/17/11
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
TNMCA ;[TNM Compute percentage of TNM forms completed]
N SDT,EDT,IEN,TNMA,TNMC,TNMACNT,TNMCCNT,TNMP,RPTDATE,DIVISION
N PID,NAM,SGP,DFC,TNA,START,END,Y
K TNM
W @IOF
W !?3,"Compute percentage of TNM forms completed",!
S %DT="AE",%DT("A")=" Start Date of First Contact: "
D ^%DT K %DT
Q:Y<1 S START=Y,SDT=Y-1
S %DT="AE",%DT("A")=" End Date of First Contact..: ",%DT("B")="TODAY"
D ^%DT K %DT
Q:Y<1 S (END,EDT)=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 TNM D ^%ZISC K %ZIS,IOP G EXIT
;
TNM S (TNMACNT,TNMCCNT)=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 TNMA=$P($G(^ONCO(165.5,IEN,7)),U,7)
.S TNMC=$P($G(^ONCO(165.5,IEN,7)),U,14)
.I (TNMA="")!(TNMA="0000000")!(TNMA=8888888)!(TNMA=9999999) Q
.S TNMACNT=TNMACNT+1
.I (TNMC="")!(TNMC="0000000")!(TNMC=8888888)!(TNMC=9999999) S TNM(IEN)="" Q
.S TNMCCNT=TNMCCNT+1
I TNMACNT=0 D W ! D PAUSE^ONCOPA2A G EXIT
.W !,?3,"No TNM Forms have been assigned."
S TNMP=TNMCCNT/TNMACNT
S TNMP=$J(TNMP,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,"TNM FORMS ASSIGNED/COMPLETED 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,"TNM Forms Assigned...........: ",TNMACNT
W !?3,"TNM Forms Completed..........: ",TNMCCNT
W !?3,"Percentage of Forms completed: ",TNMP
I $D(TNM) D
.W !!?3,"TNM forms assigned but not completed",?50,"First Contact",?64,"Form Assigned"
.W !," --------------------------------------------------------------------------"
.S IEN=0 F S IEN=$O(TNM(IEN)) Q:IEN'>0 D
..S PID=$$GET1^DIQ(165.5,IEN,61)
..S NAM=$$GET1^DIQ(165.5,IEN,.02)
..S SGP=$$GET1^DIQ(165.5,IEN,.01)
..S DFC=$$GET1^DIQ(165.5,IEN,155)
..S TNA=$$GET1^DIQ(165.5,IEN,25)
..W !?3,PID," ",$E(NAM,1,20),?30,$E(SGP,1,20),?50,DFC,?64,TNA
D ^%ZISC
W ! D PAUSE^ONCOPA2A
Q
;
TASK ;Queue a task
K ZTUCI,ZTDTH,ZTIO,ZTSAVE
S ZTRTN="TNM^ONCTNMC",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTDESC="Compute percentage of TNM forms completed"
S ZTSAVE("SDT")="",ZTSAVE("EDT")="",ZTSAVE("START")="",ZTSAVE("END")=""
D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
K ZTDESC,ZTREQ,ZTRTN,ZTSAVE,ZTSK
Q
;
EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCTNMC 2630 printed Nov 22, 2024@17:39:01 Page 2
ONCTNMC ;Hines OIFO/GWB [TNM Compute percentage of TNM forms completed] ;03/17/11
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
TNMCA ;[TNM Compute percentage of TNM forms completed]
+1 NEW SDT,EDT,IEN,TNMA,TNMC,TNMACNT,TNMCCNT,TNMP,RPTDATE,DIVISION
+2 NEW PID,NAM,SGP,DFC,TNA,START,END,Y
+3 KILL TNM
+4 WRITE @IOF
+5 WRITE !?3,"Compute percentage of TNM forms completed",!
+6 SET %DT="AE"
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="AE"
SET %DT("A")=" End Date of First Contact..: "
SET %DT("B")="TODAY"
+10 DO ^%DT
KILL %DT
+11 if Y<1
QUIT
SET (END,EDT)=Y
+12 WRITE !
+13 NEW %ZIS,IOP,POP
+14 SET %ZIS="MQ"
+15 DO ^%ZIS
if $GET(POP)
QUIT
+16 IF $DATA(IO("Q"))
DO TASK
GOTO EXIT
+17 USE IO
DO TNM
DO ^%ZISC
KILL %ZIS,IOP
GOTO EXIT
+18 ;
TNM SET (TNMACNT,TNMCCNT)=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 TNMA=$PIECE($GET(^ONCO(165.5,IEN,7)),U,7)
+3 SET TNMC=$PIECE($GET(^ONCO(165.5,IEN,7)),U,14)
+4 IF (TNMA="")!(TNMA="0000000")!(TNMA=8888888)!(TNMA=9999999)
QUIT
+5 SET TNMACNT=TNMACNT+1
+6 IF (TNMC="")!(TNMC="0000000")!(TNMC=8888888)!(TNMC=9999999)
SET TNM(IEN)=""
QUIT
+7 SET TNMCCNT=TNMCCNT+1
End DoDot:1
+8 IF TNMACNT=0
Begin DoDot:1
+9 WRITE !,?3,"No TNM Forms have been assigned."
End DoDot:1
WRITE !
DO PAUSE^ONCOPA2A
GOTO EXIT
+10 SET TNMP=TNMCCNT/TNMACNT
+11 SET TNMP=$JUSTIFY(TNMP,3,2)*100_"%"
+12 SET Y=DT
DO DD^%DT
SET RPTDATE=Y
+13 SET DIVISION=$PIECE(^DIC(4,DUZ(2),0),U,1)
+14 SET Y=START
DO DD^%DT
SET START=Y
+15 SET Y=END
DO DD^%DT
SET END=Y
+16 WRITE !
+17 WRITE !?3,"TNM FORMS ASSIGNED/COMPLETED REPORT",?60,RPTDATE
+18 WRITE !
+19 WRITE !?3,"Start Date of First Contact..: ",START
+20 WRITE !?3,"End Date of First Contact....: ",END
+21 WRITE !?3,"Division.....................: ",DIVISION
+22 WRITE !?3,"TNM Forms Assigned...........: ",TNMACNT
+23 WRITE !?3,"TNM Forms Completed..........: ",TNMCCNT
+24 WRITE !?3,"Percentage of Forms completed: ",TNMP
+25 IF $DATA(TNM)
Begin DoDot:1
+26 WRITE !!?3,"TNM forms assigned but not completed",?50,"First Contact",?64,"Form Assigned"
+27 WRITE !," --------------------------------------------------------------------------"
+28 SET IEN=0
FOR
SET IEN=$ORDER(TNM(IEN))
if IEN'>0
QUIT
Begin DoDot:2
+29 SET PID=$$GET1^DIQ(165.5,IEN,61)
+30 SET NAM=$$GET1^DIQ(165.5,IEN,.02)
+31 SET SGP=$$GET1^DIQ(165.5,IEN,.01)
+32 SET DFC=$$GET1^DIQ(165.5,IEN,155)
+33 SET TNA=$$GET1^DIQ(165.5,IEN,25)
+34 WRITE !?3,PID," ",$EXTRACT(NAM,1,20),?30,$EXTRACT(SGP,1,20),?50,DFC,?64,TNA
End DoDot:2
End DoDot:1
+35 DO ^%ZISC
+36 WRITE !
DO PAUSE^ONCOPA2A
+37 QUIT
+38 ;
TASK ;Queue a task
+1 KILL ZTUCI,ZTDTH,ZTIO,ZTSAVE
+2 SET ZTRTN="TNM^ONCTNMC"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+3 SET ZTDESC="Compute percentage of TNM forms completed"
+4 SET ZTSAVE("SDT")=""
SET ZTSAVE("EDT")=""
SET ZTSAVE("START")=""
SET ZTSAVE("END")=""
+5 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
+6 KILL ZTDESC,ZTREQ,ZTRTN,ZTSAVE,ZTSK
+7 QUIT
+8 ;
EXIT QUIT
