- 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 Feb 18, 2025@23:51:41 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