ONCPCS.m

ONCPCS ;HINES OIFO/GWB - Collaborative Staging display ;11/09/11

 ;;2.2;ONCOLOGY;**1,4,6,19**;Jul 31, 2013;Build 4

 ;

 Q:$G(TOP)=""

 N DISCRIM,HIST,MO,SCHNAME,SITE

 S MO=$$HIST^ONCFUNC(D0)

 S SITE=$TR($$GET1^DIQ(164,TOP,1,"I"),".","")

 S HIST=$E(MO,1,4)

 S DISCRIM=$$GET1^DIQ(165.5,D0,240)

 ;S SCHEMA=+$$SCHEMA^ONCSAPIS(.ONCSAPI,SITE,HIST,DISCRIM)

 S ONCCSSNM="" D GETSCHM^ONCWEBCS,PARSESCR^ONCWEBP2

 S SCHEMA=ONCCSSNM I ONCCSSNM="" S SCHEMA="Unable to compute schema"

 K ONCCSSNM N I,NUM,ONC,SECTION,SSFCNT,SSFLIST

 K DASHES S $P(DASHES,"-",80)="-"

 S SECTION="Collaborative Staging" D SECTION^ONCOAIP

 N DI,DIC,DR,DA,DIQ,ONC

 K ONC

 S DIC="^ONCO(165.5,"

 S DR="29.2;30.2;29.1;31.1;32.1;32;33;34.3;34.31:34.36;34.4;44.1:44.999;160;161;162;163;164;165;166;167;168;169;160.7;161.7;162.7;163.7;164.7;165.7;166.7;247;283"

 S DA=D0,DIQ="ONC",DIQ(0)="IE" D EN^DIQ1

 I $L(ONC(165.5,D0,32,"I"))=1 S ONC(165.5,D0,32,"I")="0"_ONC(165.5,D0,32,"I")

 I $L(ONC(165.5,D0,33,"I"))=1 S ONC(165.5,D0,33,"I")="0"_ONC(165.5,D0,33,"I")

 S SSFLIST="",SSFCNT=0

 F I=44.1,44.2,44.3,44.4,44.5,44.6,44.7,44.8,44.9,44.101,44.11,44.12,44.13,44.14,44.15,44.16,44.17,44.18,44.19,44.201,44.21,44.22,44.23,44.24,44.25 D

 .I ONC(165.5,D0,I,"I")'="",ONC(165.5,D0,I,"I")'=988 S SSFCNT=SSFCNT+1,SSFLIST(SSFCNT)=I

 W !," Schema name: ",SCHEMA

 W !,DASHES

 I ONC(165.5,D0,247,"I")=1 D

 .W !," CS Review Required......: ",ONC(165.5,D0,247,"E")

 .W !," CS Field Needing Review.: ",ONC(165.5,D0,283,"E")

 W !," Tumor Size (CS).........: ",ONC(165.5,D0,29.2,"I"),?35,"AJCC-6 T...........: ",ONC(165.5,D0,160,"E")

 W !," Extension (CS)..........: ",ONC(165.5,D0,30.2,"I"),?35,"AJCC-6 T Descriptor: ",ONC(165.5,D0,161,"E")

 W !," Tumor Size/Ext Eval (CS): ",ONC(165.5,D0,29.1,"I"),?35,"AJCC-6 N...........: ",ONC(165.5,D0,162,"E")

 W !," Lymph Nodes (CS)........: ",ONC(165.5,D0,31.1,"I"),?35,"AJCC-6 N Descriptor: ",ONC(165.5,D0,163,"E")

 W !," Lymph Nodes Eval (CS)...: ",ONC(165.5,D0,32.1,"I"),?35,"AJCC-6 M...........: ",ONC(165.5,D0,164,"E")

 W !," Regional Nodes Examined.: ",ONC(165.5,D0,33,"I"),?35,"AJCC-6 M Descriptor: ",ONC(165.5,D0,165,"E")

 W !," Regional Nodes Positive.: ",ONC(165.5,D0,32,"I"),?35,"AJCC-6 Stage Group.: ",ONC(165.5,D0,166,"E")

 W !," Mets at DX (CS).........: ",ONC(165.5,D0,34.3,"I"),?35,"AJCC-7 T...........: ",ONC(165.5,D0,160.7,"E")

 W !," Mets at DX-Bone.........: ",ONC(165.5,D0,34.31,"I"),?35,"AJCC-7 T Descriptor: ",ONC(165.5,D0,161.7,"E")

 W !," Mets at DX-Brain........: ",ONC(165.5,D0,34.32,"I"),?35,"AJCC-7 N...........: ",ONC(165.5,D0,162.7,"E")

 W !," Mets at DX-Liver........: ",ONC(165.5,D0,34.33,"I"),?35,"AJCC-7 N Descriptor: ",ONC(165.5,D0,163.7,"E")

 W !," Mets at DX-Lung.........: ",ONC(165.5,D0,34.34,"I"),?35,"AJCC-7 M...........: ",ONC(165.5,D0,164.7,"E")

 W !," Mets at DX-Distant LN...: ",ONC(165.5,D0,34.35,"I"),?35,"AJCC-7 M Descriptor: ",ONC(165.5,D0,165.7,"E")

 W !," Mets at DX-Other........: ",ONC(165.5,D0,34.36,"I"),?35,"AJCC-7 Stage Group.: ",ONC(165.5,D0,166.7,"E")

 W !," Mets Eval (CS)..........: ",ONC(165.5,D0,34.4,"I"),?35,"SS1977.............: ",ONC(165.5,D0,167,"E")

 ;

 S NUM=1 D SSF

 W ?35,"SS2000.............: ",ONC(165.5,D0,168,"E")

 S NUM=2 D SSF

 W ?35,"CS version.........: ",ONC(165.5,D0,169,"E")

 S NUM=3 D SSF

 S NUM=4 D SSF

 S NUM=5 D SSF

 S NUM=6 D SSF

 S NUM=7 D SSF

 S NUM=8 D SSF

 S NUM=9 D SSF

 S NUM=10 D SSF

 S NUM=11 D SSF

 S NUM=12 D SSF

 S NUM=13 D SSF

 S NUM=14 D SSF

 S NUM=15 D SSF

 S NUM=16 D SSF

 S NUM=17 D SSF

 S NUM=18 D SSF

 S NUM=19 D SSF

 S NUM=20 D SSF

 S NUM=21 D SSF

 S NUM=22 D SSF

 S NUM=23 D SSF

 S NUM=24 D SSF

 S NUM=25 D SSF

 W !,DASHES

 Q

 ;

SSF ;SSF LIST

 N DOTS,SSFNUM

 I $G(SSFLIST(NUM)) D

 .S SSFNUM=$E($P(^DD(165.5,SSFLIST(NUM),0),U,1),4,5)

 .S DOTS=$S($L(SSFNUM)=1:"....................: ",1:"...................: ")

 .W !," SSF",SSFNUM,DOTS,ONC(165.5,D0,SSFLIST(NUM),"I")

 E  I NUM<5 W !

 Q

 ;

CLEANUP ;Cleanup

 K D0,ONCCSSNM,SCHEMA,TOP

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ONCPCS   4007     printed  Feb 18, 2025@23:53:33                                                                                                                                                                                                      Page 2

ONCPCS    ;HINES OIFO/GWB - Collaborative Staging display ;11/09/11

 +1       ;;2.2;ONCOLOGY;**1,4,6,19**;Jul 31, 2013;Build 4

 +2       ;

 +3        if $GET(TOP)=""

               QUIT 

 +4        NEW DISCRIM,HIST,MO,SCHNAME,SITE

 +5        SET MO=$$HIST^ONCFUNC(D0)

 +6        SET SITE=$TRANSLATE($$GET1^DIQ(164,TOP,1,"I"),".","")

 +7        SET HIST=$EXTRACT(MO,1,4)

 +8        SET DISCRIM=$$GET1^DIQ(165.5,D0,240)

 +9       ;S SCHEMA=+$$SCHEMA^ONCSAPIS(.ONCSAPI,SITE,HIST,DISCRIM)

 +10       SET ONCCSSNM=""

           DO GETSCHM^ONCWEBCS

           DO PARSESCR^ONCWEBP2

 +11       SET SCHEMA=ONCCSSNM

           IF ONCCSSNM=""

               SET SCHEMA="Unable to compute schema"

 +12       KILL ONCCSSNM

           NEW I,NUM,ONC,SECTION,SSFCNT,SSFLIST

 +13       KILL DASHES

           SET $PIECE(DASHES,"-",80)="-"

 +14       SET SECTION="Collaborative Staging"

           DO SECTION^ONCOAIP

 +15       NEW DI,DIC,DR,DA,DIQ,ONC

 +16       KILL ONC

 +17       SET DIC="^ONCO(165.5,"

 +18       SET DR="29.2;30.2;29.1;31.1;32.1;32;33;34.3;34.31:34.36;34.4;44.1:44.999;160;161;162;163;164;165;166;167;168;169;160.7;161.7;162.7;163.7;164.7;165.7;166.7;247;283"

 +19       SET DA=D0

           SET DIQ="ONC"

           SET DIQ(0)="IE"

           DO EN^DIQ1

 +20       IF $LENGTH(ONC(165.5,D0,32,"I"))=1

               SET ONC(165.5,D0,32,"I")="0"_ONC(165.5,D0,32,"I")

 +21       IF $LENGTH(ONC(165.5,D0,33,"I"))=1

               SET ONC(165.5,D0,33,"I")="0"_ONC(165.5,D0,33,"I")

 +22       SET SSFLIST=""

           SET SSFCNT=0

 +23       FOR I=44.1,44.2,44.3,44.4,44.5,44.6,44.7,44.8,44.9,44.101,44.11,44.12,44.13,44.14,44.15,44.16,44.17,44.18,44.19,44.201,44.21,44.22,44.23,44.24,44.25

               Begin DoDot:1

 +24               IF ONC(165.5,D0,I,"I")'=""

                       IF ONC(165.5,D0,I,"I")'=988

                           SET SSFCNT=SSFCNT+1

                           SET SSFLIST(SSFCNT)=I

               End DoDot:1

 +25       WRITE !," Schema name: ",SCHEMA

 +26       WRITE !,DASHES

 +27       IF ONC(165.5,D0,247,"I")=1

               Begin DoDot:1

 +28               WRITE !," CS Review Required......: ",ONC(165.5,D0,247,"E")

 +29               WRITE !," CS Field Needing Review.: ",ONC(165.5,D0,283,"E")

               End DoDot:1

 +30       WRITE !," Tumor Size (CS).........: ",ONC(165.5,D0,29.2,"I"),?35,"AJCC-6 T...........: ",ONC(165.5,D0,160,"E")

 +31       WRITE !," Extension (CS)..........: ",ONC(165.5,D0,30.2,"I"),?35,"AJCC-6 T Descriptor: ",ONC(165.5,D0,161,"E")

 +32       WRITE !," Tumor Size/Ext Eval (CS): ",ONC(165.5,D0,29.1,"I"),?35,"AJCC-6 N...........: ",ONC(165.5,D0,162,"E")

 +33       WRITE !," Lymph Nodes (CS)........: ",ONC(165.5,D0,31.1,"I"),?35,"AJCC-6 N Descriptor: ",ONC(165.5,D0,163,"E")

 +34       WRITE !," Lymph Nodes Eval (CS)...: ",ONC(165.5,D0,32.1,"I"),?35,"AJCC-6 M...........: ",ONC(165.5,D0,164,"E")

 +35       WRITE !," Regional Nodes Examined.: ",ONC(165.5,D0,33,"I"),?35,"AJCC-6 M Descriptor: ",ONC(165.5,D0,165,"E")

 +36       WRITE !," Regional Nodes Positive.: ",ONC(165.5,D0,32,"I"),?35,"AJCC-6 Stage Group.: ",ONC(165.5,D0,166,"E")

 +37       WRITE !," Mets at DX (CS).........: ",ONC(165.5,D0,34.3,"I"),?35,"AJCC-7 T...........: ",ONC(165.5,D0,160.7,"E")

 +38       WRITE !," Mets at DX-Bone.........: ",ONC(165.5,D0,34.31,"I"),?35,"AJCC-7 T Descriptor: ",ONC(165.5,D0,161.7,"E")

 +39       WRITE !," Mets at DX-Brain........: ",ONC(165.5,D0,34.32,"I"),?35,"AJCC-7 N...........: ",ONC(165.5,D0,162.7,"E")

 +40       WRITE !," Mets at DX-Liver........: ",ONC(165.5,D0,34.33,"I"),?35,"AJCC-7 N Descriptor: ",ONC(165.5,D0,163.7,"E")

 +41       WRITE !," Mets at DX-Lung.........: ",ONC(165.5,D0,34.34,"I"),?35,"AJCC-7 M...........: ",ONC(165.5,D0,164.7,"E")

 +42       WRITE !," Mets at DX-Distant LN...: ",ONC(165.5,D0,34.35,"I"),?35,"AJCC-7 M Descriptor: ",ONC(165.5,D0,165.7,"E")

 +43       WRITE !," Mets at DX-Other........: ",ONC(165.5,D0,34.36,"I"),?35,"AJCC-7 Stage Group.: ",ONC(165.5,D0,166.7,"E")

 +44       WRITE !," Mets Eval (CS)..........: ",ONC(165.5,D0,34.4,"I"),?35,"SS1977.............: ",ONC(165.5,D0,167,"E")

 +45      ;

 +46       SET NUM=1

           DO SSF

 +47       WRITE ?35,"SS2000.............: ",ONC(165.5,D0,168,"E")

 +48       SET NUM=2

           DO SSF

 +49       WRITE ?35,"CS version.........: ",ONC(165.5,D0,169,"E")

 +50       SET NUM=3

           DO SSF

 +51       SET NUM=4

           DO SSF

 +52       SET NUM=5

           DO SSF

 +53       SET NUM=6

           DO SSF

 +54       SET NUM=7

           DO SSF

 +55       SET NUM=8

           DO SSF

 +56       SET NUM=9

           DO SSF

 +57       SET NUM=10

           DO SSF

 +58       SET NUM=11

           DO SSF

 +59       SET NUM=12

           DO SSF

 +60       SET NUM=13

           DO SSF

 +61       SET NUM=14

           DO SSF

 +62       SET NUM=15

           DO SSF

 +63       SET NUM=16

           DO SSF

 +64       SET NUM=17

           DO SSF

 +65       SET NUM=18

           DO SSF

 +66       SET NUM=19

           DO SSF

 +67       SET NUM=20

           DO SSF

 +68       SET NUM=21

           DO SSF

 +69       SET NUM=22

           DO SSF

 +70       SET NUM=23

           DO SSF

 +71       SET NUM=24

           DO SSF

 +72       SET NUM=25

           DO SSF

 +73       WRITE !,DASHES

 +74       QUIT 

 +75      ;

SSF       ;SSF LIST

 +1        NEW DOTS,SSFNUM

 +2        IF $GET(SSFLIST(NUM))

               Begin DoDot:1

 +3                SET SSFNUM=$EXTRACT($PIECE(^DD(165.5,SSFLIST(NUM),0),U,1),4,5)

 +4                SET DOTS=$SELECT($LENGTH(SSFNUM)=1:"....................: ",1:"...................: ")

 +5                WRITE !," SSF",SSFNUM,DOTS,ONC(165.5,D0,SSFLIST(NUM),"I")

               End DoDot:1

 +6       IF '$TEST

               IF NUM<5

                   WRITE !

 +7        QUIT 

 +8       ;

CLEANUP   ;Cleanup

 +1        KILL D0,ONCCSSNM,SCHEMA,TOP