- 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 ---[H[J[2J[HONCPCS 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