ONCTNMC.m

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 ---ONCTNMC   2630     printed  Apr 23, 2025@18:43:29                                                                                                                                                                                                     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