ONCSSF6 ;Hines OIFO/GWB - SITE-SPECIFIC FACTOR 6 (165.5,44.6) ;11/20/03
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
;SITE-SPECIFIC FACTOR 6 (165.5,44.6)
SSF6IT ;INPUT TRANSFORM
;
S PS=$P($G(^ONCO(165.5,D0,2)),U,1)
I PS="" K X W " No PRIMARY SITE defined for this primary" Q
S MO=$$HIST^ONCFUNC(D0)
;
S SSFIEN=$S($D(^ONCO(164.52,"C",PS_"-6")):$O(^ONCO(164.52,"C",PS_"-6",0)),1:1)
;
;Malignant Melanoma of Skin, Vulva, Penis, Scrotum
I $$MELANOMA^ONCOU55(D0) D
.S MELIEN=$O(^ONCO(164.52,"B","LDH",0))
.I $E(PS,3,4)=44 S SSFIEN=MELIEN Q
.I $E(PS,3,4)=51 S SSFIEN=MELIEN Q
.I $E(PS,3,4)=60 S SSFIEN=MELIEN Q
.I PS=67632 S SSFIEN=MELIEN Q
;
;Hodgkin and Non-Hodgkin Lymphomas of All Sites
I $$LYMPHOMA^ONCFUNC(D0) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Mycosis Fungoides and Sezary Disease of Skin, Vulva, Penis, Scrotum
;Kaposi Sarcoma of All Sites
I (MO=97003)!(MO=97013)!($E(MO,1,4)=9140) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Hematopoietic, Reticuloendothelial, Immunoproliferative, and
;Myeloproliferative Neoplasms
I (MO'<97310)&(MO'>99899) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Retinoblastoma
I $E(MO,1,3)=951 S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Prostate
I PS=67619,+X>1,+X<11 D G ITEX
.I X'?3N D K X Q
..I X?1N W !!," For ",X," enter 00",X
..I X?2N W !!," For ",X," enter 0",X
;
I '$D(^ONCO(164.52,SSFIEN,1,"B",X)) K X Q
S SSF=$O(^ONCO(164.52,SSFIEN,1,"B",X,0))
W " ",$P(^ONCO(164.52,SSFIEN,1,SSF,0),U,2)
ITEX K PS,SSFIEN,SSF,MO,MELING Q
;
SSF6OT ;OUTPUT TRANSFORM
;
S PS=$P($G(^ONCO(165.5,D0,2)),U,1)
Q:PS=""
S MO=$$HIST^ONCFUNC(D0)
;
S SSFIEN=$S($D(^ONCO(164.52,"C",PS_"-6")):$O(^ONCO(164.52,"C",PS_"-6",0)),1:1)
;
;Malignant Melanoma of Skin, Vulva, Penis, Scrotum
I $$MELANOMA^ONCOU55(D0) D
.S MELIEN=$O(^ONCO(164.52,"B","LDH",0))
.I $E(PS,3,4)=44 S SSFIEN=MELIEN Q
.I $E(PS,3,4)=51 S SSFIEN=MELIEN Q
.I $E(PS,3,4)=60 S SSFIEN=MELIEN Q
.I PS=67632 S SSFIEN=MELIEN Q
;
;Hodgkin and Non-Hodgkin Lymphomas of All Sites
I $$LYMPHOMA^ONCFUNC(D0) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Mycosis Fungoides and Sezary Disease of Skin, Vulva, Penis, Scrotum
;Kaposi Sarcoma of All Sites
I (MO=97003)!(MO=97013)!($E(MO,1,4)=9140) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Hematopoietic, Reticuloendothelial, Immunoproliferative, and
I (MO'<97310)&(MO'>99899) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Retinoblastoma
I $E(MO,1,3)=951 S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Prostate
I PS=67619,+Y>1,+Y<11 G OTEX
;
S SSF=$O(^ONCO(164.52,SSFIEN,1,"B",Y,0)) I SSF="" G OTEX
S Y=$P($G(^ONCO(164.52,SSFIEN,1,SSF,0)),U,2)
OTEX K PS,SSFIEN,SSF,MO Q
;
SSF6HP ;HELP
;
S PS=$P($G(^ONCO(165.5,D0,2)),U,1)
Q:PS=""
S MO=$$HIST^ONCFUNC(D0)
;
S SSFIEN=$S($D(^ONCO(164.52,"C",PS_"-6")):$O(^ONCO(164.52,"C",PS_"-6",0)),1:1)
;
;Malignant Melanoma of Skin, Vulva, Penis, Scrotum
I $$MELANOMA^ONCOU55(D0) D
.S MELIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
.I $E(PS,3,4)=44 S SSFIEN=MELIEN Q
.I $E(PS,3,4)=51 S SSFIEN=MELIEN Q
.I $E(PS,3,4)=60 S SSFIEN=MELIEN Q
.I PS=67632 S SSFIEN=MELIEN Q
;
;Hodgkin and Non-Hodgkin Lymphomas of All Sites
I $$LYMPHOMA^ONCFUNC(D0) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Mycosis Fungoides and Sezary Disease of Skin, Vulva, Penis, Scrotum
;Kaposi Sarcoma of All Sites
I (MO=97003)!(MO=97013)!($E(MO,1,4)=9140) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Hematopoietic, Reticuloendothelial, Immunoproliferative, and
I (MO'<97310)&(MO'>99899) S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
;Retinoblastoma
I $E(MO,1,3)=951 S SSFIEN=$O(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
;
W !," SITE-SPECIFIC FACTOR 6 for " D
.I MO=97003 W "MYCOSIS FUNGOIDES of ",$P(^ONCO(164,PS,0),U,1)," (",$P(^ONCO(164,PS,0),U,2),")" Q
.I MO=97013 W "SEZARY SYNDROME of ",$P(^ONCO(164,PS,0),U,1)," (",$P(^ONCO(164,PS,0),U,2),")" Q
.I $E(MO,1,3)=951 W "RETINOBLASTOMA of ",$P(^ONCO(164,PS,0),U,1)," (",$P(^ONCO(164,PS,0),U,2),")" Q
.I $$MELANOMA^ONCOU55(D0),($E(PS,3,4)=44)!($E(PS,3,4)=51)!($E(PS,3,4)=60)!(PS=67632)!($E(PS,3,4)=69) W "MALIGNANT MELANOMA of ",$P(^ONCO(164,PS,0),U,1)," (",$P(^ONCO(164,PS,0),U,2),")" Q
.I $E(MO,1,4)=9140 W "KAPOSI SARCOMA of ALL SITES" Q
.I $$LYMPHOMA^ONCFUNC(D0) W "HODGKIN AND NON-HODGKIN LYMPHOMAS of ALL SITES" Q
.I (MO'<97310)&(MO'>99899) W $P(^ONCO(169.3,MO,0),U,1)," (",$P(^ONCO(169.3,MO,0),U,2),")" Q
.W $P(^ONCO(164,PS,0),U,1)," (",$P(^ONCO(164,PS,0),U,2),")"
W !," ",$P(^ONCO(164.52,SSFIEN,0),U,1)
;S SSF=0 F S SSF=$O(^ONCO(164.52,SSFIEN,1,SSF)) Q:SSF'>0 D
;.S TAB=6
;.I ($P(^ONCO(164.52,SSFIEN,0),U,1)="GLEASON'S SCORE") S TAB=10
;.W " ",$P(^ONCO(164.52,SSFIEN,1,SSF,0),U,1),?TAB,$P(^ONCO(164.52,SSFIEN,1,SSF,0),U,2),!
K PS,SSFIEN,SSF,MO Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSSF6 5144 printed Oct 16, 2024@18:29:33 Page 2
ONCSSF6 ;Hines OIFO/GWB - SITE-SPECIFIC FACTOR 6 (165.5,44.6) ;11/20/03
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 ;SITE-SPECIFIC FACTOR 6 (165.5,44.6)
SSF6IT ;INPUT TRANSFORM
+1 ;
+2 SET PS=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+3 IF PS=""
KILL X
WRITE " No PRIMARY SITE defined for this primary"
QUIT
+4 SET MO=$$HIST^ONCFUNC(D0)
+5 ;
+6 SET SSFIEN=$SELECT($DATA(^ONCO(164.52,"C",PS_"-6")):$ORDER(^ONCO(164.52,"C",PS_"-6",0)),1:1)
+7 ;
+8 ;Malignant Melanoma of Skin, Vulva, Penis, Scrotum
+9 IF $$MELANOMA^ONCOU55(D0)
Begin DoDot:1
+10 SET MELIEN=$ORDER(^ONCO(164.52,"B","LDH",0))
+11 IF $EXTRACT(PS,3,4)=44
SET SSFIEN=MELIEN
QUIT
+12 IF $EXTRACT(PS,3,4)=51
SET SSFIEN=MELIEN
QUIT
+13 IF $EXTRACT(PS,3,4)=60
SET SSFIEN=MELIEN
QUIT
+14 IF PS=67632
SET SSFIEN=MELIEN
QUIT
End DoDot:1
+15 ;
+16 ;Hodgkin and Non-Hodgkin Lymphomas of All Sites
+17 IF $$LYMPHOMA^ONCFUNC(D0)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+18 ;
+19 ;Mycosis Fungoides and Sezary Disease of Skin, Vulva, Penis, Scrotum
+20 ;Kaposi Sarcoma of All Sites
+21 IF (MO=97003)!(MO=97013)!($EXTRACT(MO,1,4)=9140)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+22 ;
+23 ;Hematopoietic, Reticuloendothelial, Immunoproliferative, and
+24 ;Myeloproliferative Neoplasms
+25 IF (MO'<97310)&(MO'>99899)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+26 ;
+27 ;Retinoblastoma
+28 IF $EXTRACT(MO,1,3)=951
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+29 ;
+30 ;Prostate
+31 IF PS=67619
IF +X>1
IF +X<11
Begin DoDot:1
+32 IF X'?3N
Begin DoDot:2
+33 IF X?1N
WRITE !!," For ",X," enter 00",X
+34 IF X?2N
WRITE !!," For ",X," enter 0",X
End DoDot:2
KILL X
QUIT
End DoDot:1
GOTO ITEX
+35 ;
+36 IF '$DATA(^ONCO(164.52,SSFIEN,1,"B",X))
KILL X
QUIT
+37 SET SSF=$ORDER(^ONCO(164.52,SSFIEN,1,"B",X,0))
+38 WRITE " ",$PIECE(^ONCO(164.52,SSFIEN,1,SSF,0),U,2)
ITEX KILL PS,SSFIEN,SSF,MO,MELING
QUIT
+1 ;
SSF6OT ;OUTPUT TRANSFORM
+1 ;
+2 SET PS=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+3 if PS=""
QUIT
+4 SET MO=$$HIST^ONCFUNC(D0)
+5 ;
+6 SET SSFIEN=$SELECT($DATA(^ONCO(164.52,"C",PS_"-6")):$ORDER(^ONCO(164.52,"C",PS_"-6",0)),1:1)
+7 ;
+8 ;Malignant Melanoma of Skin, Vulva, Penis, Scrotum
+9 IF $$MELANOMA^ONCOU55(D0)
Begin DoDot:1
+10 SET MELIEN=$ORDER(^ONCO(164.52,"B","LDH",0))
+11 IF $EXTRACT(PS,3,4)=44
SET SSFIEN=MELIEN
QUIT
+12 IF $EXTRACT(PS,3,4)=51
SET SSFIEN=MELIEN
QUIT
+13 IF $EXTRACT(PS,3,4)=60
SET SSFIEN=MELIEN
QUIT
+14 IF PS=67632
SET SSFIEN=MELIEN
QUIT
End DoDot:1
+15 ;
+16 ;Hodgkin and Non-Hodgkin Lymphomas of All Sites
+17 IF $$LYMPHOMA^ONCFUNC(D0)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+18 ;
+19 ;Mycosis Fungoides and Sezary Disease of Skin, Vulva, Penis, Scrotum
+20 ;Kaposi Sarcoma of All Sites
+21 IF (MO=97003)!(MO=97013)!($EXTRACT(MO,1,4)=9140)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+22 ;
+23 ;Hematopoietic, Reticuloendothelial, Immunoproliferative, and
+24 IF (MO'<97310)&(MO'>99899)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+25 ;
+26 ;Retinoblastoma
+27 IF $EXTRACT(MO,1,3)=951
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+28 ;
+29 ;Prostate
+30 IF PS=67619
IF +Y>1
IF +Y<11
GOTO OTEX
+31 ;
+32 SET SSF=$ORDER(^ONCO(164.52,SSFIEN,1,"B",Y,0))
IF SSF=""
GOTO OTEX
+33 SET Y=$PIECE($GET(^ONCO(164.52,SSFIEN,1,SSF,0)),U,2)
OTEX KILL PS,SSFIEN,SSF,MO
QUIT
+1 ;
SSF6HP ;HELP
+1 ;
+2 SET PS=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+3 if PS=""
QUIT
+4 SET MO=$$HIST^ONCFUNC(D0)
+5 ;
+6 SET SSFIEN=$SELECT($DATA(^ONCO(164.52,"C",PS_"-6")):$ORDER(^ONCO(164.52,"C",PS_"-6",0)),1:1)
+7 ;
+8 ;Malignant Melanoma of Skin, Vulva, Penis, Scrotum
+9 IF $$MELANOMA^ONCOU55(D0)
Begin DoDot:1
+10 SET MELIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+11 IF $EXTRACT(PS,3,4)=44
SET SSFIEN=MELIEN
QUIT
+12 IF $EXTRACT(PS,3,4)=51
SET SSFIEN=MELIEN
QUIT
+13 IF $EXTRACT(PS,3,4)=60
SET SSFIEN=MELIEN
QUIT
+14 IF PS=67632
SET SSFIEN=MELIEN
QUIT
End DoDot:1
+15 ;
+16 ;Hodgkin and Non-Hodgkin Lymphomas of All Sites
+17 IF $$LYMPHOMA^ONCFUNC(D0)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+18 ;
+19 ;Mycosis Fungoides and Sezary Disease of Skin, Vulva, Penis, Scrotum
+20 ;Kaposi Sarcoma of All Sites
+21 IF (MO=97003)!(MO=97013)!($EXTRACT(MO,1,4)=9140)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+22 ;
+23 ;Hematopoietic, Reticuloendothelial, Immunoproliferative, and
+24 IF (MO'<97310)&(MO'>99899)
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+25 ;
+26 ;Retinoblastoma
+27 IF $EXTRACT(MO,1,3)=951
SET SSFIEN=$ORDER(^ONCO(164.52,"B","NOT APPLICABLE FOR THIS SITE",0))
+28 ;
+29 WRITE !," SITE-SPECIFIC FACTOR 6 for "
Begin DoDot:1
+30 IF MO=97003
WRITE "MYCOSIS FUNGOIDES of ",$PIECE(^ONCO(164,PS,0),U,1)," (",$PIECE(^ONCO(164,PS,0),U,2),")"
QUIT
+31 IF MO=97013
WRITE "SEZARY SYNDROME of ",$PIECE(^ONCO(164,PS,0),U,1)," (",$PIECE(^ONCO(164,PS,0),U,2),")"
QUIT
+32 IF $EXTRACT(MO,1,3)=951
WRITE "RETINOBLASTOMA of ",$PIECE(^ONCO(164,PS,0),U,1)," (",$PIECE(^ONCO(164,PS,0),U,2),")"
QUIT
+33 IF $$MELANOMA^ONCOU55(D0)
IF ($EXTRACT(PS,3,4)=44)!($EXTRACT(PS,3,4)=51)!($EXTRACT(PS,3,4)=60)!(PS=67632)!($EXTRACT(PS,3,4)=69)
WRITE "MALIGNANT MELANOMA of ",$PIECE(^ONCO(164,PS,0),U,1)," (",$PIECE(^ONCO(164,PS,0),U,2),")"
QUIT
+34 IF $EXTRACT(MO,1,4)=9140
WRITE "KAPOSI SARCOMA of ALL SITES"
QUIT
+35 IF $$LYMPHOMA^ONCFUNC(D0)
WRITE "HODGKIN AND NON-HODGKIN LYMPHOMAS of ALL SITES"
QUIT
+36 IF (MO'<97310)&(MO'>99899)
WRITE $PIECE(^ONCO(169.3,MO,0),U,1)," (",$PIECE(^ONCO(169.3,MO,0),U,2),")"
QUIT
+37 WRITE $PIECE(^ONCO(164,PS,0),U,1)," (",$PIECE(^ONCO(164,PS,0),U,2),")"
End DoDot:1
+38 WRITE !," ",$PIECE(^ONCO(164.52,SSFIEN,0),U,1)
+39 ;S SSF=0 F S SSF=$O(^ONCO(164.52,SSFIEN,1,SSF)) Q:SSF'>0 D
+40 ;.S TAB=6
+41 ;.I ($P(^ONCO(164.52,SSFIEN,0),U,1)="GLEASON'S SCORE") S TAB=10
+42 ;.W " ",$P(^ONCO(164.52,SSFIEN,1,SSF,0),U,1),?TAB,$P(^ONCO(164.52,SSFIEN,1,SSF,0),U,2),!
+43 KILL PS,SSFIEN,SSF,MO
QUIT
