ONCOMNI ;Hines OIFO/GWB - MISCELLANEOUS ;12/10/99
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
;D SETUP^ONCOES
;S NAME=$P(@ONCOX1,U,1),FNMI=$P(NAME,",",2),MNI=$P(FNMI," ",2)
;I (MNI="JR")!(MNI="JR.")!(MNI="SR")!(MNI="SR.")!(MNI="MD")!(MNI="MD.")!(MNI="NMN")!(MNI="NMN.")!(MNI="NMI")!(MNI="NMI.")!(MNI="II")!(MNI="III")!(MNI="IV") S MNI=""
;I $L(MNI)=2,$E(MNI,2)="." S MNI=$E(MNI,1)
;S X=$E(MNI,1,14)
;K ONCON,ONCOX,ONCOX1,NAME,FNMI,MNI
Q
CHFPS ;CALCULATE VALUE OF FIELD #803 (CANCER HISTORY-1ST PRIMARY SITE)
I $P($G(^ONCO(165.5,D0,"NHL1")),U,4)'="" S X="" Q
S CHFSNM=$P($G(^ONCO(165.5,D0,0)),U,2)
S X="C88.8",CHFSFLG=0
S CHFS="" F S CHFS=$O(^ONCO(165.5,"C",CHFSNM,CHFS)) Q:CHFS'>""!(CHFSFLG>0) I $$DIV^ONCFUNC(CHFS)=DUZ(2) D
.I CHFS=D0 Q
.S CHFSFLG=CHFSFLG+1,TPX=$P($G(^ONCO(165.5,CHFS,2)),U,1) S:TPX'="" TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
K CHFS,CHFSFLG,CHFSNM,TPX Q
CHFPH ;CALCULATE VALUE OF FIELD #804 (CANCER HISTORY-1ST PRIMARY HISTOLOGY)
I $P($G(^ONCO(165.5,D0,"NHL1")),U,5)'="" S X="" Q
S CHFHNM=$P($G(^ONCO(165.5,D0,0)),U,2)
S X="8888/8",CHFHFLG=0
S CHFH="" F S CHFH=$O(^ONCO(165.5,"C",CHFHNM,CHFH)) Q:CHFH'>""!(CHFHFLG>0) I $$DIV^ONCFUNC(CHFH)=DUZ(2) D
.I CHFH=D0 Q
.S CHFHFLG=CHFHFLG+1,TPX=$$HIST^ONCFUNC(CHFH,.HSTFLD,.HISTNAM,.ICDFILE) S:TPX'="" TPX=$G(^ONCO(ICDFILE,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
K CHFH,CHFHFLG,CHFHNM,HISTNAM,HSTFLD,ICDFILE,TPX Q
;
CHSPS ;CALCULATE VALUE OF FIELD #805 (CANCER HISTORY-2ND PRIMARY SITE)
I $P($G(^ONCO(165.5,D0,"NHL1")),U,6)'="" S X="" Q
S CHSSNM=$P($G(^ONCO(165.5,D0,0)),U,2)
S X="C88.8",CHSSFLG=0
S CHSS="" F S CHSS=$O(^ONCO(165.5,"C",CHSSNM,CHSS)) Q:CHSS'>""!(CHSSFLG>1) I $$DIV^ONCFUNC(CHSS)=DUZ(2) D
.I CHSS=D0 Q
.I CHSSFLG=0 S CHSSFLG=CHSSFLG+1 Q
.S CHSSFLG=CHSSFLG+1,TPX=$P($G(^ONCO(165.5,CHSS,2)),U,1) S:TPX'="" TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
K CHSS,CHSSFLG,CHSSNM,TPX Q
CHSPH ;CALCULATE VALUE OF FIELD #806 (CANCER HISTORY-2ND PRIMARY HISTOLOGY)
I $P($G(^ONCO(165.5,D0,"NHL1")),U,7)'="" S X="" Q
S CHSHNM=$P($G(^ONCO(165.5,D0,0)),U,2)
S X="8888/8",CHSHFLG=0
S CHSH="" F S CHSH=$O(^ONCO(165.5,"C",CHSHNM,CHSH)) Q:CHSH'>""!(CHSHFLG>1) I $$DIV^ONCFUNC(CHSH)=DUZ(2) D
.I CHSH=D0 Q
.I CHSHFLG=0 S CHSHFLG=CHSHFLG+1 Q
.S CHSHFLG=CHSHFLG+1,TPX=$$HIST^ONCFUNC(CHSH,.HSTFLD,.HISTNAM,.ICDFILE) S:TPX'="" TPX=$G(^ONCO(ICDFILE,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
K CHSH,CHSHFLG,CHSHNM,TPX Q
ARCHHLP ;AIDS RISK CATEGORY FOR HIV POSITIVE PATIENT (#822) HELP
W !?5,"Choose from the following codes:",!
W !?8,"0 Not HIV positive"
W !?8,"1 No known risk category"
W !?8,"2 Homosexual/Bisexual"
W !?8,"3 IV drug user"
W !?8,"4 Blood product recipient"
W !?8,"5 Heterosexual transmission"
W !?8,"6 Congenitally acquired"
W !?8,"7 Multiple categories"
W !?8,"8 Other/Unknown risk category"
W !?8,"9 Unknown if HIV positive",!
Q
ARCHP ;AIDS RISK CATEGORY FOR HIV POSITIVE PATIENT (#822) OUTPUT TRANSFORM
I Y=0 S Y="Not HIV positive" Q
I Y=1 S Y="No known risk category" Q
I Y=2 S Y="Homosexual/Bisexual" Q
I Y=3 S Y="IV drug user" Q
I Y=4 S Y="Blood product recipient" Q
I Y=5 S Y="Heterosexual transmission" Q
I Y=6 S Y="Congenitally acquired" Q
I Y=7 S Y="Multiple categories" Q
I Y=8 S Y="Other/Unknown risk category" Q
I Y=9 S Y="Unknown if HIV positive" Q
Q
EXNSIT ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) INPUT TRANSFORM
N CCD
I X[U!(X="") K X Q
I $L(X)<3 W *7," Must be at least 3 characters " K X Q
I X=888!(X="C888")!(X=88.8)!(X="C88.8") S X="C888" W " None" Q
I X=999!(X="C999")!(X=99.9)!(X="C99.9") S X="C999" W " Unknown" Q
K DIC S DIC="^ONCO(164,",DIC(0)="EMQ" D ^DIC
I Y<0 K X Q
I +Y'<0 S CCD=$P($G(^ONCO(164,+Y,0)),U,2) S X=$E(CCD,1,3)_$E(CCD,5) Q
EXNSOT ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) OUTPUT TRANSFORM
I Y="C888" S Y="None" Q
I Y="C999" S Y="Unknown" Q
S EXN=$E(Y,1,3)_"."_$E(Y,4)
F TPG=0:0 S TPG=$O(^ONCO(164,TPG)) Q:TPG'>0 D
.I EXN'=$P($G(^ONCO(164,TPG,0)),U,2) Q
.S TPGNM=$P($G(^ONCO(164,TPG,0)),U,1),EXN=EXN_" "_TPGNM Q
S Y=EXN K EXN,TPG,TPGNM Q
XHP ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) EXECUTABLE HELP
I X'="?",X'="??" Q
K DIC S DIC="^ONCO(164,",DIC(0)="EMQ" D ^DIC Q
RCSIT ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) INPUT TRANSFORM
I X=0!(X=5)!(X=6) K X Q
S Y=X D RCSOT W " ",Y K Y
Q
RCSOT ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) OUTPUT TRANSFORM
I Y=1 S Y="Radiation before chemotherapy"
I Y=2 S Y="Chemotherapy before radiation"
I Y=3 S Y="Chemotherapy before and after radiation"
I Y=4 S Y="Radiation and chemotherapy concurrently"
I Y=7 S Y="Unknown if radiation and/or chemo given"
I Y=8 S Y="NA, no radiation and/or no chemo given"
I Y=9 S Y="Sequence unknown"
Q
RCSHP ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) HELP
N DTDX,FSDX
W !," 1 Radiation before chemotherapy"
W !," 2 Chemotherapy before radiation"
W !," 3 Chemotherapy before and after radiation"
W !," 4 Radiation and chemotherapy concurrently"
W !," 7 Unknown if radiation and/or chemo given"
W !," 8 NA, no radiation and/or no chemo given"
W !," 9 Sequence unknown",!
Q
S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X K %DT
I $D(X) S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16) I DTDX'="" K:X<DTDX X
FSC ;Calculate default for fields #1102,#1103
;I $P($G(^ONCO(165.5,D0,"MEL1")),U,3)'="" S X="" Q
S PNM=$P($G(^ONCO(165.5,D0,0)),U,2),X="C88.8",FSDX="88/8888"
S ST=0 F S ST=$O(^ONCO(165.5,"C",PNM,ST)) Q:ST'>0 I $$DIV^ONCFUNC(ST)=DUZ(2) S LAST=ST
I LAST'=D0 D
.S Y=$P($G(^ONCO(165.5,LAST,0)),U,16) D CHDTOT^ONCOPCE S FSDX=Y
.S TPX=$P($G(^ONCO(165.5,LAST,2)),U,1) I TPX="" Q
.S TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
I LAST=D0 F S LAST=$O(^ONCO(165.5,"C",PNM,LAST),-1) Q:LAST="" I $$DIV^ONCFUNC(LAST)=DUZ(2) D Q
.S Y=$P($G(^ONCO(165.5,LAST,0)),U,16) D CHDTOT^ONCOPCE S FSDX=Y
.S TPX=$P($G(^ONCO(165.5,LAST,2)),U,1) I TPX="" Q
.S TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
K LAST,PNM,ST,TPX Q
SSC ;Calculate default for fields #1104,#1105
S PNM=$P($G(^ONCO(165.5,D0,0)),U,2),X="C88.8",SSDX="88/8888",FLG=0
S ST=0 F S ST=$O(^ONCO(165.5,"C",PNM,ST)) Q:ST'>0 I $$DIV^ONCFUNC(ST)=DUZ(2) S LAST=ST
I LAST'=D0 S FLG=FLG+1
S SSC=LAST F S SSC=$O(^ONCO(165.5,"C",PNM,SSC),-1) Q:SSC'>""!(FLG>1) I $$DIV^ONCFUNC(SSC)=DUZ(2) D
.I SSC=D0 Q
.I FLG=0 S FLG=FLG+1 Q
.S FLG=FLG+1
.S Y=$P($G(^ONCO(165.5,SSC,0)),U,16) D CHDTOT^ONCOPCE S SSDX=Y
.S TPX=$P($G(^ONCO(165.5,SSC,2)),U,1) S:TPX'="" TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
K FLG,LAST,PNM,SSC,SSDX,ST,TPX Q
;
NSNIT ;Number of Satellite Nodules (#1112)
I X'?1.2N K X Q
I X=0!(X="00") S X="00" W " No satellite nodules"
I X=96 W " 96 or more nodules"
I X=97 W " Satellite nodules, # unknown"
I X=98 W " NA, non-cutaneous melanoma"
I X=99 W " Unknown"
S X=$S($L(X)=1:"0"_X,1:X)
Q
NSNOT ;Number of Satellite Nodules (#1112)
I Y="00" S Y="No satellite nodules" Q
I Y=96 S Y="96 or more nodules" Q
I Y=97 S Y="Satellite nodules, # unknown" Q
I Y=98 S Y="NA, non-cutaneous melanoma" Q
I Y=99 S Y="Unknown" Q
S Y=$S(Y="01":Y_" nodule",1:Y_" nodules")
Q
BTIT ;Breslow's Thickness (#1113)
I X'?1.3N K X Q
I X=997 W " Cutaneous melanoma, thickness unk"
I X=998 W " NA, non-cutaneous melanoma"
I X=999 W " Primary site unknown"
S X=$S($L(X)=1:"00"_X,$L(X)=2:"0"_X,1:X)
Q
BTOT ;Breslow's Thickness (#1113)
I Y=997 S Y="Cutaneous melanoma, thickness unk" Q
I Y=998 S Y="NA, non-cutaneous melanoma" Q
I Y=999 S Y="Primary site unknown" Q
S Y=Y_" mm"
Q
MDIT ;Margin Distance (#1120)
I X'?1.3N K X Q
I X=997 W " Margins free, distance unknown"
I X=998 W " NA, surgery not performed"
I X=999 W " Unknown"
S X=$S($L(X)=1:"00"_X,$L(X)=2:"0"_X,1:X)
Q
MDOT ;Margin Distance (#1120)
I Y=996 S Y=Y_"mm or more" Q
I Y=997 S Y="Margins free, distance unknown" Q
I Y=998 S Y="NA, surgery not performed" Q
I Y=999 S Y="Unknown" Q
S Y=Y_"mm"
Q
;
SNPIT ;Sentinel Nodes Positive (#1125)
N SNE
I X=0!(X>6) Q
S SNE=$P($G(^ONCO(165.5,D0,"MEL1")),U,25) I SNE=""!(SNE>5) Q
I X>SNE W !," Sentinel Nodes Positive MUST be less than/equal Sentinel Nodes Examined! " K X Q
Q
;
NBPIT ;Number of Basins Positive (#1129)
N NBD
I X=0!(X>6) Q
S NBD=$P($G(^ONCO(165.5,D0,"MEL1")),U,29) I NBD=""!(NBD>5) Q
I X>NBD W !," Number of Basins Positive MUST be less than/equal to Basins Detected! " K X Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOMNI 8534 printed Oct 16, 2024@18:25:51 Page 2
ONCOMNI ;Hines OIFO/GWB - MISCELLANEOUS ;12/10/99
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 ;D SETUP^ONCOES
+4 ;S NAME=$P(@ONCOX1,U,1),FNMI=$P(NAME,",",2),MNI=$P(FNMI," ",2)
+5 ;I (MNI="JR")!(MNI="JR.")!(MNI="SR")!(MNI="SR.")!(MNI="MD")!(MNI="MD.")!(MNI="NMN")!(MNI="NMN.")!(MNI="NMI")!(MNI="NMI.")!(MNI="II")!(MNI="III")!(MNI="IV") S MNI=""
+6 ;I $L(MNI)=2,$E(MNI,2)="." S MNI=$E(MNI,1)
+7 ;S X=$E(MNI,1,14)
+8 ;K ONCON,ONCOX,ONCOX1,NAME,FNMI,MNI
+9 QUIT
CHFPS ;CALCULATE VALUE OF FIELD #803 (CANCER HISTORY-1ST PRIMARY SITE)
+1 IF $PIECE($GET(^ONCO(165.5,D0,"NHL1")),U,4)'=""
SET X=""
QUIT
+2 SET CHFSNM=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
+3 SET X="C88.8"
SET CHFSFLG=0
+4 SET CHFS=""
FOR
SET CHFS=$ORDER(^ONCO(165.5,"C",CHFSNM,CHFS))
if CHFS'>""!(CHFSFLG>0)
QUIT
IF $$DIV^ONCFUNC(CHFS)=DUZ(2)
Begin DoDot:1
+5 IF CHFS=D0
QUIT
+6 SET CHFSFLG=CHFSFLG+1
SET TPX=$PIECE($GET(^ONCO(165.5,CHFS,2)),U,1)
if TPX'=""
SET TPX=$GET(^ONCO(164,TPX,0))
if TPX'=""
SET X=$PIECE(TPX,U,2)
QUIT
End DoDot:1
+7 KILL CHFS,CHFSFLG,CHFSNM,TPX
QUIT
CHFPH ;CALCULATE VALUE OF FIELD #804 (CANCER HISTORY-1ST PRIMARY HISTOLOGY)
+1 IF $PIECE($GET(^ONCO(165.5,D0,"NHL1")),U,5)'=""
SET X=""
QUIT
+2 SET CHFHNM=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
+3 SET X="8888/8"
SET CHFHFLG=0
+4 SET CHFH=""
FOR
SET CHFH=$ORDER(^ONCO(165.5,"C",CHFHNM,CHFH))
if CHFH'>""!(CHFHFLG>0)
QUIT
IF $$DIV^ONCFUNC(CHFH)=DUZ(2)
Begin DoDot:1
+5 IF CHFH=D0
QUIT
+6 SET CHFHFLG=CHFHFLG+1
SET TPX=$$HIST^ONCFUNC(CHFH,.HSTFLD,.HISTNAM,.ICDFILE)
if TPX'=""
SET TPX=$GET(^ONCO(ICDFILE,TPX,0))
if TPX'=""
SET X=$PIECE(TPX,U,2)
QUIT
End DoDot:1
+7 KILL CHFH,CHFHFLG,CHFHNM,HISTNAM,HSTFLD,ICDFILE,TPX
QUIT
+8 ;
CHSPS ;CALCULATE VALUE OF FIELD #805 (CANCER HISTORY-2ND PRIMARY SITE)
+1 IF $PIECE($GET(^ONCO(165.5,D0,"NHL1")),U,6)'=""
SET X=""
QUIT
+2 SET CHSSNM=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
+3 SET X="C88.8"
SET CHSSFLG=0
+4 SET CHSS=""
FOR
SET CHSS=$ORDER(^ONCO(165.5,"C",CHSSNM,CHSS))
if CHSS'>""!(CHSSFLG>1)
QUIT
IF $$DIV^ONCFUNC(CHSS)=DUZ(2)
Begin DoDot:1
+5 IF CHSS=D0
QUIT
+6 IF CHSSFLG=0
SET CHSSFLG=CHSSFLG+1
QUIT
+7 SET CHSSFLG=CHSSFLG+1
SET TPX=$PIECE($GET(^ONCO(165.5,CHSS,2)),U,1)
if TPX'=""
SET TPX=$GET(^ONCO(164,TPX,0))
if TPX'=""
SET X=$PIECE(TPX,U,2)
QUIT
End DoDot:1
+8 KILL CHSS,CHSSFLG,CHSSNM,TPX
QUIT
CHSPH ;CALCULATE VALUE OF FIELD #806 (CANCER HISTORY-2ND PRIMARY HISTOLOGY)
+1 IF $PIECE($GET(^ONCO(165.5,D0,"NHL1")),U,7)'=""
SET X=""
QUIT
+2 SET CHSHNM=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
+3 SET X="8888/8"
SET CHSHFLG=0
+4 SET CHSH=""
FOR
SET CHSH=$ORDER(^ONCO(165.5,"C",CHSHNM,CHSH))
if CHSH'>""!(CHSHFLG>1)
QUIT
IF $$DIV^ONCFUNC(CHSH)=DUZ(2)
Begin DoDot:1
+5 IF CHSH=D0
QUIT
+6 IF CHSHFLG=0
SET CHSHFLG=CHSHFLG+1
QUIT
+7 SET CHSHFLG=CHSHFLG+1
SET TPX=$$HIST^ONCFUNC(CHSH,.HSTFLD,.HISTNAM,.ICDFILE)
if TPX'=""
SET TPX=$GET(^ONCO(ICDFILE,TPX,0))
if TPX'=""
SET X=$PIECE(TPX,U,2)
QUIT
End DoDot:1
+8 KILL CHSH,CHSHFLG,CHSHNM,TPX
QUIT
ARCHHLP ;AIDS RISK CATEGORY FOR HIV POSITIVE PATIENT (#822) HELP
+1 WRITE !?5,"Choose from the following codes:",!
+2 WRITE !?8,"0 Not HIV positive"
+3 WRITE !?8,"1 No known risk category"
+4 WRITE !?8,"2 Homosexual/Bisexual"
+5 WRITE !?8,"3 IV drug user"
+6 WRITE !?8,"4 Blood product recipient"
+7 WRITE !?8,"5 Heterosexual transmission"
+8 WRITE !?8,"6 Congenitally acquired"
+9 WRITE !?8,"7 Multiple categories"
+10 WRITE !?8,"8 Other/Unknown risk category"
+11 WRITE !?8,"9 Unknown if HIV positive",!
+12 QUIT
ARCHP ;AIDS RISK CATEGORY FOR HIV POSITIVE PATIENT (#822) OUTPUT TRANSFORM
+1 IF Y=0
SET Y="Not HIV positive"
QUIT
+2 IF Y=1
SET Y="No known risk category"
QUIT
+3 IF Y=2
SET Y="Homosexual/Bisexual"
QUIT
+4 IF Y=3
SET Y="IV drug user"
QUIT
+5 IF Y=4
SET Y="Blood product recipient"
QUIT
+6 IF Y=5
SET Y="Heterosexual transmission"
QUIT
+7 IF Y=6
SET Y="Congenitally acquired"
QUIT
+8 IF Y=7
SET Y="Multiple categories"
QUIT
+9 IF Y=8
SET Y="Other/Unknown risk category"
QUIT
+10 IF Y=9
SET Y="Unknown if HIV positive"
QUIT
+11 QUIT
EXNSIT ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) INPUT TRANSFORM
+1 NEW CCD
+2 IF X[U!(X="")
KILL X
QUIT
+3 IF $LENGTH(X)<3
WRITE *7," Must be at least 3 characters "
KILL X
QUIT
+4 IF X=888!(X="C888")!(X=88.8)!(X="C88.8")
SET X="C888"
WRITE " None"
QUIT
+5 IF X=999!(X="C999")!(X=99.9)!(X="C99.9")
SET X="C999"
WRITE " Unknown"
QUIT
+6 KILL DIC
SET DIC="^ONCO(164,"
SET DIC(0)="EMQ"
DO ^DIC
+7 IF Y<0
KILL X
QUIT
+8 IF +Y'<0
SET CCD=$PIECE($GET(^ONCO(164,+Y,0)),U,2)
SET X=$EXTRACT(CCD,1,3)_$EXTRACT(CCD,5)
QUIT
EXNSOT ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) OUTPUT TRANSFORM
+1 IF Y="C888"
SET Y="None"
QUIT
+2 IF Y="C999"
SET Y="Unknown"
QUIT
+3 SET EXN=$EXTRACT(Y,1,3)_"."_$EXTRACT(Y,4)
+4 FOR TPG=0:0
SET TPG=$ORDER(^ONCO(164,TPG))
if TPG'>0
QUIT
Begin DoDot:1
+5 IF EXN'=$PIECE($GET(^ONCO(164,TPG,0)),U,2)
QUIT
+6 SET TPGNM=$PIECE($GET(^ONCO(164,TPG,0)),U,1)
SET EXN=EXN_" "_TPGNM
QUIT
End DoDot:1
+7 SET Y=EXN
KILL EXN,TPG,TPGNM
QUIT
XHP ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) EXECUTABLE HELP
+1 IF X'="?"
IF X'="??"
QUIT
+2 KILL DIC
SET DIC="^ONCO(164,"
SET DIC(0)="EMQ"
DO ^DIC
QUIT
RCSIT ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) INPUT TRANSFORM
+1 IF X=0!(X=5)!(X=6)
KILL X
QUIT
+2 SET Y=X
DO RCSOT
WRITE " ",Y
KILL Y
+3 QUIT
RCSOT ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) OUTPUT TRANSFORM
+1 IF Y=1
SET Y="Radiation before chemotherapy"
+2 IF Y=2
SET Y="Chemotherapy before radiation"
+3 IF Y=3
SET Y="Chemotherapy before and after radiation"
+4 IF Y=4
SET Y="Radiation and chemotherapy concurrently"
+5 IF Y=7
SET Y="Unknown if radiation and/or chemo given"
+6 IF Y=8
SET Y="NA, no radiation and/or no chemo given"
+7 IF Y=9
SET Y="Sequence unknown"
+8 QUIT
RCSHP ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) HELP
+1 NEW DTDX,FSDX
+2 WRITE !," 1 Radiation before chemotherapy"
+3 WRITE !," 2 Chemotherapy before radiation"
+4 WRITE !," 3 Chemotherapy before and after radiation"
+5 WRITE !," 4 Radiation and chemotherapy concurrently"
+6 WRITE !," 7 Unknown if radiation and/or chemo given"
+7 WRITE !," 8 NA, no radiation and/or no chemo given"
+8 WRITE !," 9 Sequence unknown",!
+9 QUIT
+10 SET %DT="EP"
SET %DT(0)="-NOW"
DO ^%DT
SET X=Y
if Y<1
KILL X
KILL %DT
+11 IF $DATA(X)
SET DTDX=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF DTDX'=""
if X<DTDX
KILL X
FSC ;Calculate default for fields #1102,#1103
+1 ;I $P($G(^ONCO(165.5,D0,"MEL1")),U,3)'="" S X="" Q
+2 SET PNM=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
SET X="C88.8"
SET FSDX="88/8888"
+3 SET ST=0
FOR
SET ST=$ORDER(^ONCO(165.5,"C",PNM,ST))
if ST'>0
QUIT
IF $$DIV^ONCFUNC(ST)=DUZ(2)
SET LAST=ST
+4 IF LAST'=D0
Begin DoDot:1
+5 SET Y=$PIECE($GET(^ONCO(165.5,LAST,0)),U,16)
DO CHDTOT^ONCOPCE
SET FSDX=Y
+6 SET TPX=$PIECE($GET(^ONCO(165.5,LAST,2)),U,1)
IF TPX=""
QUIT
+7 SET TPX=$GET(^ONCO(164,TPX,0))
if TPX'=""
SET X=$PIECE(TPX,U,2)
QUIT
End DoDot:1
+8 IF LAST=D0
FOR
SET LAST=$ORDER(^ONCO(165.5,"C",PNM,LAST),-1)
if LAST=""
QUIT
IF $$DIV^ONCFUNC(LAST)=DUZ(2)
Begin DoDot:1
+9 SET Y=$PIECE($GET(^ONCO(165.5,LAST,0)),U,16)
DO CHDTOT^ONCOPCE
SET FSDX=Y
+10 SET TPX=$PIECE($GET(^ONCO(165.5,LAST,2)),U,1)
IF TPX=""
QUIT
+11 SET TPX=$GET(^ONCO(164,TPX,0))
if TPX'=""
SET X=$PIECE(TPX,U,2)
QUIT
End DoDot:1
QUIT
+12 KILL LAST,PNM,ST,TPX
QUIT
SSC ;Calculate default for fields #1104,#1105
+1 SET PNM=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
SET X="C88.8"
SET SSDX="88/8888"
SET FLG=0
+2 SET ST=0
FOR
SET ST=$ORDER(^ONCO(165.5,"C",PNM,ST))
if ST'>0
QUIT
IF $$DIV^ONCFUNC(ST)=DUZ(2)
SET LAST=ST
+3 IF LAST'=D0
SET FLG=FLG+1
+4 SET SSC=LAST
FOR
SET SSC=$ORDER(^ONCO(165.5,"C",PNM,SSC),-1)
if SSC'>""!(FLG>1)
QUIT
IF $$DIV^ONCFUNC(SSC)=DUZ(2)
Begin DoDot:1
+5 IF SSC=D0
QUIT
+6 IF FLG=0
SET FLG=FLG+1
QUIT
+7 SET FLG=FLG+1
+8 SET Y=$PIECE($GET(^ONCO(165.5,SSC,0)),U,16)
DO CHDTOT^ONCOPCE
SET SSDX=Y
+9 SET TPX=$PIECE($GET(^ONCO(165.5,SSC,2)),U,1)
if TPX'=""
SET TPX=$GET(^ONCO(164,TPX,0))
if TPX'=""
SET X=$PIECE(TPX,U,2)
QUIT
End DoDot:1
+10 KILL FLG,LAST,PNM,SSC,SSDX,ST,TPX
QUIT
+11 ;
NSNIT ;Number of Satellite Nodules (#1112)
+1 IF X'?1.2N
KILL X
QUIT
+2 IF X=0!(X="00")
SET X="00"
WRITE " No satellite nodules"
+3 IF X=96
WRITE " 96 or more nodules"
+4 IF X=97
WRITE " Satellite nodules, # unknown"
+5 IF X=98
WRITE " NA, non-cutaneous melanoma"
+6 IF X=99
WRITE " Unknown"
+7 SET X=$SELECT($LENGTH(X)=1:"0"_X,1:X)
+8 QUIT
NSNOT ;Number of Satellite Nodules (#1112)
+1 IF Y="00"
SET Y="No satellite nodules"
QUIT
+2 IF Y=96
SET Y="96 or more nodules"
QUIT
+3 IF Y=97
SET Y="Satellite nodules, # unknown"
QUIT
+4 IF Y=98
SET Y="NA, non-cutaneous melanoma"
QUIT
+5 IF Y=99
SET Y="Unknown"
QUIT
+6 SET Y=$SELECT(Y="01":Y_" nodule",1:Y_" nodules")
+7 QUIT
BTIT ;Breslow's Thickness (#1113)
+1 IF X'?1.3N
KILL X
QUIT
+2 IF X=997
WRITE " Cutaneous melanoma, thickness unk"
+3 IF X=998
WRITE " NA, non-cutaneous melanoma"
+4 IF X=999
WRITE " Primary site unknown"
+5 SET X=$SELECT($LENGTH(X)=1:"00"_X,$LENGTH(X)=2:"0"_X,1:X)
+6 QUIT
BTOT ;Breslow's Thickness (#1113)
+1 IF Y=997
SET Y="Cutaneous melanoma, thickness unk"
QUIT
+2 IF Y=998
SET Y="NA, non-cutaneous melanoma"
QUIT
+3 IF Y=999
SET Y="Primary site unknown"
QUIT
+4 SET Y=Y_" mm"
+5 QUIT
MDIT ;Margin Distance (#1120)
+1 IF X'?1.3N
KILL X
QUIT
+2 IF X=997
WRITE " Margins free, distance unknown"
+3 IF X=998
WRITE " NA, surgery not performed"
+4 IF X=999
WRITE " Unknown"
+5 SET X=$SELECT($LENGTH(X)=1:"00"_X,$LENGTH(X)=2:"0"_X,1:X)
+6 QUIT
MDOT ;Margin Distance (#1120)
+1 IF Y=996
SET Y=Y_"mm or more"
QUIT
+2 IF Y=997
SET Y="Margins free, distance unknown"
QUIT
+3 IF Y=998
SET Y="NA, surgery not performed"
QUIT
+4 IF Y=999
SET Y="Unknown"
QUIT
+5 SET Y=Y_"mm"
+6 QUIT
+7 ;
SNPIT ;Sentinel Nodes Positive (#1125)
+1 NEW SNE
+2 IF X=0!(X>6)
QUIT
+3 SET SNE=$PIECE($GET(^ONCO(165.5,D0,"MEL1")),U,25)
IF SNE=""!(SNE>5)
QUIT
+4 IF X>SNE
WRITE !," Sentinel Nodes Positive MUST be less than/equal Sentinel Nodes Examined! "
KILL X
QUIT
+5 QUIT
+6 ;
NBPIT ;Number of Basins Positive (#1129)
+1 NEW NBD
+2 IF X=0!(X>6)
QUIT
+3 SET NBD=$PIECE($GET(^ONCO(165.5,D0,"MEL1")),U,29)
IF NBD=""!(NBD>5)
QUIT
+4 IF X>NBD
WRITE !," Number of Basins Positive MUST be less than/equal to Basins Detected! "
KILL X
QUIT
+5 QUIT
