ONCSCHMM.m

ONCSCHMM ;HINES OIFO/RTK - Miscellaneous schema code ;07/25/19

 ;;2.2;ONCOLOGY;**10,12,13,15,17,18,20**;Jul 31, 2013;Build 5

 ;

 Q

 ;

SCRNLV ;Screen for Lymph-Vascular Invasion field

 I $P($G(^ONCO(165.5,D0,0)),"^",16)<3180000,((Y<2)!(Y>7)) Q

 D ^ONCSCHMA I ('$D(ONCSCMA))!(ONCSCMA=0) Q

 I $P($G(^ONCO(165.5,D0,0)),"^",16)>3171231 D SCHMCHK

 I $P($G(^ONCO(165.5,D0,0)),"^",16)>3171231 I ONCNO8S=1,(Y'=8) Q

 I $P($G(^ONCO(165.5,D0,0)),"^",16)>3171231 I ONCONL8=1,(Y=8) Q

 I $P($G(^ONCO(165.5,D0,0)),"^",16)>3171231 I ONCNO8S=0,ONCONL8=0,Y<100 Q

 Q

SCHMCHK ;

 S ONCNO8S=0,ONCONL8=0

 I "00210^09210^00220^00241^00242^00381^00382^00383^00400^00410^00421^00422^00440^00450^00459^00480^00580^00600^00610^00631^00633^00640^00660^00671^00672^00700^00750^00090^00310^00360^00430^0073^00740^00760"[ONCSCMA Q  ;all codes apply

 I "00071^00072^00073^00074^00075^00076^00077^00080^00100^00111^00112^00121^00122^00130^00131^00132^00133^00161^00169^00170^00180^00190^09190^00200^00230^00250"[ONCSCMA S ONCNO8S=1 Q  ;code 8 does not apply

 I "00260^00270^00280^00290^00301^00302^00320^00330^00340^00350^00460^00470^00500^00510^00520^09520^00528^00530^00541^00542^00560^00570^00590^00620"[ONCSCMA S ONCNO8S=1 Q  ;code 8 does not apply

 I "00060^00118^00119^00128^00140^00150^00278^00288^00358^00370^00378^00458^00478^00551^00552^00553^00558^00559^00598^00638"[ONCSCMA S ONCONL8=1 Q

 I "00650^00680^00690^00698^00710^00718^00721^00722^00723^00770^00778^00790^00795^00811^00812^00821^00822^00830^99999"[ONCSCMA S ONCONL8=1 Q  ;only 8s

 Q

SCRNSS ;Screen for SUMMARY STAGE 2018 (#1764) field

 N Z S Z=0 N ONCHIT S ONCHIT=0 D ^ONCSCHMA I ('$D(ONCSCMA))!(ONCSCMA=0) Q

 I "00381^00382^00383^00400^00410^00421^00422^00440^00450^00458^00459^00528^00541^00680^00811"[ONCSCMA S ONCHIT=1,Z=$S((Y'=0)&(Y'=8):1,1:0) I Z Q

 I "00071^00072^00073^00074^00075^00076^00077^00360^00370"[ONCSCMA S ONCHIT=1,Z=$S((Y'=8):1,1:0) I Z Q

 I "00060^"[ONCSCMA S ONCHIT=1,Z=$S((Y'=0)&(Y'=1)&(Y'=2)&(Y'=8):1,1:0) I Z Q

 I "00721^09721^00722^09722^09724"[ONCSCMA S ONCHIT=1,Z=$S((Y'=0)&(Y'=3)&(Y'=4):1,1:0) I Z Q

 I "00723^09723"[ONCSCMA S ONCHIT=1,Z=$S((Y'=3)&(Y'=4):1,1:0) I Z Q

 I "00710^00790^00795^00812"[ONCSCMA S ONCHIT=1,Z=$S((Y'=0)&(Y'=3)&(Y'=4)&(Y'=8):1,1:0) I Z Q

 I "00821^00822"[ONCSCMA S ONCHIT=1,Z=$S((Y'=0)&(Y'=2)&(Y'=4)&(Y'=8):1,1:0) I Z Q

 I "00830^"[ONCSCMA S ONCHIT=1,Z=$S((Y'=0)&(Y'=2)&(Y'=3)&(Y'=4)&(Y'=8):1,1:0) I Z Q

 I "99999^"[ONCSCMA S ONCHIT=1,Z=$S((Y=9):1,1:0) I Z Q

 I ONCHIT=0 I ONCSCMA<999999 S Z=1 I Z Q

 Q

SCRNFIV ;Screen for fields #3804,3811,3885,3907,3933

 I $P($G(^ONCO(165.5,D0,2)),"^",1)=67421,(Y'=5) Q

 I $P($G(^ONCO(165.5,D0,2)),"^",1)'=67421,(Y<10) Q

 Q

SCRN555 ;Screen for fields #3857,3869,3930,3931

 I $P($G(^ONCO(165.5,D0,"SSD4")),"^",21)=0,(Y'=5) Q

 I $P($G(^ONCO(165.5,D0,"SSD4")),"^",21)'=0,(Y<10) Q

 Q

RADPH3 ;

 I $L(X)=3 Q

 S X=$E("000000",1,(3-$L(X)))_X

 Q

RADPH5 ;

 I $L(X)=5 Q

 S X=$E("000000",1,(5-$L(X)))_X

 Q

RADPH6 ;

 I $L(X)=6 Q

 S X=$E("000000",1,(6-$L(X)))_X

 Q

SPS23 ;

 I '((X?1"A"3N)!(X?1"B"3N)) K X Q

 Q

DEC1 ;Input transforms & decimals for SSDi's to accept XX & decimals

 S X=$TR(X,"ax","AX")

 I X?1N S X=X_".0" Q

 I X?1"."1N S X="0"_X Q

 D XX1 Q

XX1 ;

 I X?1"X"1N S X="X."_$E(X,$L(X)) Q

 Q

DEC2 ;

 S X=$TR(X,"ax","AX")

 I X?1.2N S X=X_".0" Q

 I X?1"."1N S X="0"_X Q

 D XX2 Q

XX2 ;

 I X?1.2"X"1N S X="XX."_$E(X,$L(X)) Q

 Q

DEC3 ;

 S X=$TR(X,"ax","AX")

 I X?1.3N S X=X_".0" Q

 I X?1"."1N S X="0"_X Q

 D XX3 Q

XX3 ;

 I X?1.3"X"1N S X="XXX."_$E(X,$L(X)) Q

 Q

DEC4 ;

 S X=$TR(X,"ax","AX")

 I X?1.4N S X=X_".0" Q

 I X?1"."1N S X="0"_X Q

 D XX4 Q

XX4 ;

 I X?1.4"X"1N S X="XXXX."_$E(X,$L(X)) Q

 Q

DEC5 ;

 S X=$TR(X,"ax","AX")

 I X?1.5N S X=X_".0" Q

 I X?1"."1N S X="0"_X Q

 I X?6N K X Q

 D XX5 Q

XX5 ;

 I X?1.5"X"1N S X="XXXXX."_$E(X,$L(X)) Q

 Q

GEN2 ;

 S X=$TR(X,"x","X")

 I "ABCDEFGHIJKLMNOPQRSTUVWYZabcdefghijklmnopqrstuvwyz"[$E(X,1) K X Q

 I X?1N S X="0"_X

 Q

GEN3 ;

 S X=$TR(X,"x","X")

 I X?1N S X="00"_X

 I X?2N S X="0"_X

 Q

BTTIT ;Breslow Tumor Thickness Input Transform #3817

 D DEC2

 I '(X?0.2AN0.1"."1N) K X Q

 I "0123456789.AX"'[$E(X,1) K X Q

 I $E(X,1,2)="AX" S X="AX.0" Q

 Q

ERR ;ER & PR Percent Positive or Range #3826 & #3914

 S X=$TR(X,"rx","RX")

 I "0123456789RX"'[$E(X,1) K X Q

 I X?1N S X="00"_X W "  ...",X

 I X?2N S X="0"_X W "  ...",X

 I X?1"X"1N S X="X"_X W "  ...",X

 I $L(X)<3 K X Q

 I $E(X,1)="R","R10^R20^R30^R40^R50^R60^R70^R80^R90^R99"'[X K X Q

 I $E(X,1)="X","XX8^XX9"'[X K X Q

 Q

ERTA ;ER & PR Allred Score #3828 & #3916

 S X=$TR(X,"x","X")

 I X?1N S X="0"_X W "  ...",X

 I "00^01^02^03^04^05^06^07^08^X8^X9"'[X K X Q

 Q

SAR ;Sarcomatoid Features #3925

 S X=$TR(X,"rx","RX")

 I "0123456789RX"'[$E(X,1) K X Q

 I X?1N S X="00"_X W "  ...",X

 I X?2N S X="0"_X W "  ...",X

 I X?1"X"1N S X="X"_X W "  ...",X

 I X?1"R"1N S X=$E(X,1)_"0"_$E(X,2) W "  ...",X

 I $L(X)<3 K X Q

 I $E(X,1)="R","R01^R02^R03^R40^R05"'[X K X Q

 I $E(X,1)="X","XX5^XX6^XX7^XX8^XX9"'[X K X Q

 Q

FIGOHLP ; FIGO STAGE #3836

 D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) W !!,"No Schema Calculated!",!! Q

 I ONCSCMA="00500" D O1,O1A,O1B,O2,O3,O3A,O3B,O3C,O4,O4A,O4B,O97,O98,O99 Q

 I ONCSCMA="00510" D O1,O2,O3,O4,O4A,O4B,O97,O98,O99 Q

 I (ONCSCMA="00520")!(ONCSCMA="09520") D O1,O1A,O1A1,O1A2,O1B,O1B1,O1B2,O1B3,O2,O2A,O2A1,O2A2,O2B,O3,O3A,O3B,O3C,O3C1,O3C2,O4,O4A,O4B,O97,O98,O99 Q

 I (ONCSCMA="00528")!(ONCSCMA="00541") D O1,O1A,O1B,O2,O2A,O2B,O3,O3A,O3B,O3C,O4,O4A,O4B,O98,O99 Q

 I ONCSCMA="00542" D O1,O1A,O1B,O1C,O2,O2A,O2B,O3,O3A,O3B,O3C,O4,O4A,O4B,O98,O99 Q

 I ONCSCMA="00530" D O1,O1A,O1B,O2,O3,O3A,O3B,O3C,O3C1,O3C2,O4,O4A,O4B,O97,O98,O99 Q

 I (ONCSCMA="00551")!(ONCSCMA="00552")!(ONCSCMA="00553") D O1,O1A,O1B,O1C,O1C1,O1C2,O1C3,O2,O2A,O2B,O3,O3A,O3A1,O3A11,O3A12,O3A2,O3B,O3C,O4,O4A,O4B,O97,O98,O99 Q

 I ONCSCMA="00560" D O1,O2,O3,O4,O97,O98,O99 Q

 W !?4,"No FIGO Stage Codes for this Schema",!! K ONCFGLST Q

 Q

 ;

FIGO ;FIGO #3836

 I "12349"'[$E(X,1) K X Q

 I X=9 K X Q

 D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) K X Q

 I ONCSCMA="00500" D  Q  ;Vulva

 .I "1^1A^1B^2^3^3A^3B^3C^4^4A^4B^97^98^99"'[X K X Q

 I ONCSCMA="00510" D  Q  ;Vagina

 .I "1^2^3^4^4A^4B^97^98^99"'[X K X Q

 I (ONCSCMA="00520")!(ONCSCMA="09520") D  Q  ;Cervix

 .I "1^1A^1A1^1A2^1B^1B1^1B2^1B3^2^2A^2A1^2A2^2B^3^3A^3B^3C^3C1^3C2^4^4A^4B^97^98^99"'[X K X Q

 I (ONCSCMA="00528")!(ONCSCMA="00541") D  Q  ;Corpus Sarc

 .I "1^1A^1B^2^2A^2B^3^3A^3B^3C^4^4A^4B^98^99"'[X K X Q

 I ONCSCMA="00542" D  Q  ;Corpus Adeno

 .I "1^1A^1B^1C^2^2A^2B^3^3A^3B^3C^4^4A^4B^98^99"'[X K X Q

 I ONCSCMA="00530" D  Q  ;Corpus Carc

 .I "1^1A^1B^2^3^3A^3B^3C^3C1^3C2^4^4A^4B^97^98^99"'[X K X Q

 I (ONCSCMA="00551")!(ONCSCMA="00552")!(ONCSCMA="00553") D  Q  ;Ovary,Fallopian,PPC

 .I "1^1A^1B^1C^1C1^1C2^1C3^2^2A^2B^3^3A^3A1^3A11^3A12^3A2^3B^3C^4^4A^4B^97^98^99"'[X K X Q

 I ONCSCMA="00560" D  Q  ;Placenta

 .I "1^2^3^4^97^98^99"'[X K X Q

 Q

FIGOOT ;

O1 W !,"1         FIGO Stage I" Q

O1A W !,"1A        FIGO Stage IA" Q

O1A1 W !,"1A1       FIGO Stage IA1" Q

O1A2 W !,"1A2       FIGO Stage IA2" Q

O1B W !,"1B        FIGO Stage IB" Q

O1B1 W !,"1B1       FIGO Stage IB1" Q

O1B2 W !,"1B2       FIGO Stage IB2" Q

O1B3 W !,"1B3       FIGO Stage IB3" Q

O1C W !,"1C        FIGO Stage IC" Q

O1C1 W !,"1C1       FIGO Stage IC1" Q

O1C2 W !,"1C2       FIGO Stage IC2" Q

O1C3 W !,"1C3       FIGO Stage IC3" Q

O2 W !,"2         FIGO Stage II" Q

O2A W !,"2A        FIGO Stage IIA" Q

O2A1 W !,"2A1       FIGO Stage IIA1" Q

O2A2 W !,"2A2       FIGO Stage IIA2" Q

O2B W !,"2B        FIGO Stage IIB" Q

O3 W !,"3         FIGO Stage III" Q

O3A W !,"3A        FIGO Stage IIIA" Q

O3A1 W !,"3A1       FIGO Stage IIIA1" Q

O3A11 W !,"3A11      FIGO Stage IIIAi" Q

O3A12 W !,"3A12      FIGO Stage IIIAii" Q

O3A2 W !,"3A2       FIGO Stage IIIA2" Q

O3B W !,"3B        FIGO Stage IIIB" Q

O3C W !,"3C        FIGO Stage IIIC" Q

O3C1 W !,"3C1       FIGO Stage IIIC1" Q

O3C2 W !,"3C2       FIGO Stage IIIC2" Q

O4 W !,"4         FIGO Stage IV" Q

O4A W !,"4A        FIGO Stage IVA" Q

O4B W !,"4B        FIGO Stage IVB" Q

O97 W !,"97        Carcinoma in situ (intraepithelial, noninvasive, preinvasive)" Q

O98 W !,"98        Not applicable: Information not collected for this case" Q

O99 W !,"99        Not documented in medical record" Q

 Q

PROPE ;

 I X'?3N K X Q

 I "000^300^350^400^500^600^700^800^900^950^999"'[X K X Q

 Q

QTEST ;

 F GIEN=0:0 S GIEN=$O(^ONCO(164.44,GIEN)) Q:GIEN'>0  D

 .F JIEN=0:0 S JIEN=$O(^ONCO(164.44,GIEN,1,JIEN)) Q:JIEN'>0  D

 ..W !,GIEN,?3,JIEN

 ..S ONCRTKID=$P($G(^ONCO(164.44,GIEN,1,JIEN,0)),"^",3)

 ..S ONCRTKCH=$P($G(^ONCO(164.44,GIEN,1,JIEN,0)),"^",5)

 ..S ONCRTKNM=$P($G(^ONCO(164.44,GIEN,1,JIEN,0)),"^",4)

 ..W ?6,ONCRTKID,?11,ONCRTKCH,?16,ONCRTKNM

 ..I ONCRTKID'="" S ONCRTK("AJCCID",ONCRTKID)=""

 ..I ONCRTKCH'="" S ONCRTK("AJCCCH",ONCRTKCH)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ONCSCHMM   8920     printed  Feb 18, 2025@23:54:33                                                                                                                                                                                                    Page 2

ONCSCHMM  ;HINES OIFO/RTK - Miscellaneous schema code ;07/25/19

 +1       ;;2.2;ONCOLOGY;**10,12,13,15,17,18,20**;Jul 31, 2013;Build 5

 +2       ;

 +3        QUIT 

 +4       ;

SCRNLV    ;Screen for Lymph-Vascular Invasion field

 +1        IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)<3180000

               IF ((Y<2)!(Y>7))

                   QUIT 

 +2        DO ^ONCSCHMA

           IF ('$DATA(ONCSCMA))!(ONCSCMA=0)

               QUIT 

 +3        IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3171231

               DO SCHMCHK

 +4        IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3171231

               IF ONCNO8S=1

                   IF (Y'=8)

                       QUIT 

 +5        IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3171231

               IF ONCONL8=1

                   IF (Y=8)

                       QUIT 

 +6        IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3171231

               IF ONCNO8S=0

                   IF ONCONL8=0

                       IF Y<100

                           QUIT 

 +7        QUIT 

SCHMCHK   ;

 +1        SET ONCNO8S=0

           SET ONCONL8=0

 +2       ;all codes apply

           IF "00210^09210^00220^00241^00242^00381^00382^00383^00400^00410^00421^00422^00440^00450^00459^00480^00580^00600^00610^00631^00633^00640^00660^00671^00672^00700^00750^00090^00310^00360^00430^0073^00740^00760"[ONCSCMA

               QUIT 

 +3       ;code 8 does not apply

           IF "00071^00072^00073^00074^00075^00076^00077^00080^00100^00111^00112^00121^00122^00130^00131^00132^00133^00161^00169^00170^00180^00190^09190^00200^00230^00250"[ONCSCMA

               SET ONCNO8S=1

               QUIT 

 +4       ;code 8 does not apply

           IF "00260^00270^00280^00290^00301^00302^00320^00330^00340^00350^00460^00470^00500^00510^00520^09520^00528^00530^00541^00542^00560^00570^00590^00620"[ONCSCMA

               SET ONCNO8S=1

               QUIT 

 +5        IF "00060^00118^00119^00128^00140^00150^00278^00288^00358^00370^00378^00458^00478^00551^00552^00553^00558^00559^00598^00638"[ONCSCMA

               SET ONCONL8=1

               QUIT 

 +6       ;only 8s

           IF "00650^00680^00690^00698^00710^00718^00721^00722^00723^00770^00778^00790^00795^00811^00812^00821^00822^00830^99999"[ONCSCMA

               SET ONCONL8=1

               QUIT 

 +7        QUIT 

SCRNSS    ;Screen for SUMMARY STAGE 2018 (#1764) field

 +1        NEW Z

           SET Z=0

           NEW ONCHIT

           SET ONCHIT=0

           DO ^ONCSCHMA

           IF ('$DATA(ONCSCMA))!(ONCSCMA=0)

               QUIT 

 +2        IF "00381^00382^00383^00400^00410^00421^00422^00440^00450^00458^00459^00528^00541^00680^00811"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=0)&(Y'=8):1,1:0)

               IF Z

                   QUIT 

 +3        IF "00071^00072^00073^00074^00075^00076^00077^00360^00370"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=8):1,1:0)

               IF Z

                   QUIT 

 +4        IF "00060^"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=0)&(Y'=1)&(Y'=2)&(Y'=8):1,1:0)

               IF Z

                   QUIT 

 +5        IF "00721^09721^00722^09722^09724"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=0)&(Y'=3)&(Y'=4):1,1:0)

               IF Z

                   QUIT 

 +6        IF "00723^09723"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=3)&(Y'=4):1,1:0)

               IF Z

                   QUIT 

 +7        IF "00710^00790^00795^00812"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=0)&(Y'=3)&(Y'=4)&(Y'=8):1,1:0)

               IF Z

                   QUIT 

 +8        IF "00821^00822"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=0)&(Y'=2)&(Y'=4)&(Y'=8):1,1:0)

               IF Z

                   QUIT 

 +9        IF "00830^"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y'=0)&(Y'=2)&(Y'=3)&(Y'=4)&(Y'=8):1,1:0)

               IF Z

                   QUIT 

 +10       IF "99999^"[ONCSCMA

               SET ONCHIT=1

               SET Z=$SELECT((Y=9):1,1:0)

               IF Z

                   QUIT 

 +11       IF ONCHIT=0

               IF ONCSCMA<999999

                   SET Z=1

                   IF Z

                       QUIT 

 +12       QUIT 

SCRNFIV   ;Screen for fields #3804,3811,3885,3907,3933

 +1        IF $PIECE($GET(^ONCO(165.5,D0,2)),"^",1)=67421

               IF (Y'=5)

                   QUIT 

 +2        IF $PIECE($GET(^ONCO(165.5,D0,2)),"^",1)'=67421

               IF (Y<10)

                   QUIT 

 +3        QUIT 

SCRN555   ;Screen for fields #3857,3869,3930,3931

 +1        IF $PIECE($GET(^ONCO(165.5,D0,"SSD4")),"^",21)=0

               IF (Y'=5)

                   QUIT 

 +2        IF $PIECE($GET(^ONCO(165.5,D0,"SSD4")),"^",21)'=0

               IF (Y<10)

                   QUIT 

 +3        QUIT 

RADPH3    ;

 +1        IF $LENGTH(X)=3

               QUIT 

 +2        SET X=$EXTRACT("000000",1,(3-$LENGTH(X)))_X

 +3        QUIT 

RADPH5    ;

 +1        IF $LENGTH(X)=5

               QUIT 

 +2        SET X=$EXTRACT("000000",1,(5-$LENGTH(X)))_X

 +3        QUIT 

RADPH6    ;

 +1        IF $LENGTH(X)=6

               QUIT 

 +2        SET X=$EXTRACT("000000",1,(6-$LENGTH(X)))_X

 +3        QUIT 

SPS23     ;

 +1        IF '((X?1"A"3N)!(X?1"B"3N))

               KILL X

               QUIT 

 +2        QUIT 

DEC1      ;Input transforms & decimals for SSDi's to accept XX & decimals

 +1        SET X=$TRANSLATE(X,"ax","AX")

 +2        IF X?1N

               SET X=X_".0"

               QUIT 

 +3        IF X?1"."1N

               SET X="0"_X

               QUIT 

 +4        DO XX1

           QUIT 

XX1       ;

 +1        IF X?1"X"1N

               SET X="X."_$EXTRACT(X,$LENGTH(X))

               QUIT 

 +2        QUIT 

DEC2      ;

 +1        SET X=$TRANSLATE(X,"ax","AX")

 +2        IF X?1.2N

               SET X=X_".0"

               QUIT 

 +3        IF X?1"."1N

               SET X="0"_X

               QUIT 

 +4        DO XX2

           QUIT 

XX2       ;

 +1        IF X?1.2"X"1N

               SET X="XX."_$EXTRACT(X,$LENGTH(X))

               QUIT 

 +2        QUIT 

DEC3      ;

 +1        SET X=$TRANSLATE(X,"ax","AX")

 +2        IF X?1.3N

               SET X=X_".0"

               QUIT 

 +3        IF X?1"."1N

               SET X="0"_X

               QUIT 

 +4        DO XX3

           QUIT 

XX3       ;

 +1        IF X?1.3"X"1N

               SET X="XXX."_$EXTRACT(X,$LENGTH(X))

               QUIT 

 +2        QUIT 

DEC4      ;

 +1        SET X=$TRANSLATE(X,"ax","AX")

 +2        IF X?1.4N

               SET X=X_".0"

               QUIT 

 +3        IF X?1"."1N

               SET X="0"_X

               QUIT 

 +4        DO XX4

           QUIT 

XX4       ;

 +1        IF X?1.4"X"1N

               SET X="XXXX."_$EXTRACT(X,$LENGTH(X))

               QUIT 

 +2        QUIT 

DEC5      ;

 +1        SET X=$TRANSLATE(X,"ax","AX")

 +2        IF X?1.5N

               SET X=X_".0"

               QUIT 

 +3        IF X?1"."1N

               SET X="0"_X

               QUIT 

 +4        IF X?6N

               KILL X

               QUIT 

 +5        DO XX5

           QUIT 

XX5       ;

 +1        IF X?1.5"X"1N

               SET X="XXXXX."_$EXTRACT(X,$LENGTH(X))

               QUIT 

 +2        QUIT 

GEN2      ;

 +1        SET X=$TRANSLATE(X,"x","X")

 +2        IF "ABCDEFGHIJKLMNOPQRSTUVWYZabcdefghijklmnopqrstuvwyz"[$EXTRACT(X,1)

               KILL X

               QUIT 

 +3        IF X?1N

               SET X="0"_X

 +4        QUIT 

GEN3      ;

 +1        SET X=$TRANSLATE(X,"x","X")

 +2        IF X?1N

               SET X="00"_X

 +3        IF X?2N

               SET X="0"_X

 +4        QUIT 

BTTIT     ;Breslow Tumor Thickness Input Transform #3817

 +1        DO DEC2

 +2        IF '(X?0.2AN0.1"."1N)

               KILL X

               QUIT 

 +3        IF "0123456789.AX"'[$EXTRACT(X,1)

               KILL X

               QUIT 

 +4        IF $EXTRACT(X,1,2)="AX"

               SET X="AX.0"

               QUIT 

 +5        QUIT 

ERR       ;ER & PR Percent Positive or Range #3826 & #3914

 +1        SET X=$TRANSLATE(X,"rx","RX")

 +2        IF "0123456789RX"'[$EXTRACT(X,1)

               KILL X

               QUIT 

 +3        IF X?1N

               SET X="00"_X

               WRITE "  ...",X

 +4        IF X?2N

               SET X="0"_X

               WRITE "  ...",X

 +5        IF X?1"X"1N

               SET X="X"_X

               WRITE "  ...",X

 +6        IF $LENGTH(X)<3

               KILL X

               QUIT 

 +7        IF $EXTRACT(X,1)="R"

               IF "R10^R20^R30^R40^R50^R60^R70^R80^R90^R99"'[X

                   KILL X

                   QUIT 

 +8        IF $EXTRACT(X,1)="X"

               IF "XX8^XX9"'[X

                   KILL X

                   QUIT 

 +9        QUIT 

ERTA      ;ER & PR Allred Score #3828 & #3916

 +1        SET X=$TRANSLATE(X,"x","X")

 +2        IF X?1N

               SET X="0"_X

               WRITE "  ...",X

 +3        IF "00^01^02^03^04^05^06^07^08^X8^X9"'[X

               KILL X

               QUIT 

 +4        QUIT 

SAR       ;Sarcomatoid Features #3925

 +1        SET X=$TRANSLATE(X,"rx","RX")

 +2        IF "0123456789RX"'[$EXTRACT(X,1)

               KILL X

               QUIT 

 +3        IF X?1N

               SET X="00"_X

               WRITE "  ...",X

 +4        IF X?2N

               SET X="0"_X

               WRITE "  ...",X

 +5        IF X?1"X"1N

               SET X="X"_X

               WRITE "  ...",X

 +6        IF X?1"R"1N

               SET X=$EXTRACT(X,1)_"0"_$EXTRACT(X,2)

               WRITE "  ...",X

 +7        IF $LENGTH(X)<3

               KILL X

               QUIT 

 +8        IF $EXTRACT(X,1)="R"

               IF "R01^R02^R03^R40^R05"'[X

                   KILL X

                   QUIT 

 +9        IF $EXTRACT(X,1)="X"

               IF "XX5^XX6^XX7^XX8^XX9"'[X

                   KILL X

                   QUIT 

 +10       QUIT 

FIGOHLP   ; FIGO STAGE #3836

 +1        DO ^ONCSCHMA

           IF '$DATA(ONCSCMA)!(ONCSCMA=0)

               WRITE !!,"No Schema Calculated!",!!

               QUIT 

 +2        IF ONCSCMA="00500"

               DO O1

               DO O1A

               DO O1B

               DO O2

               DO O3

               DO O3A

               DO O3B

               DO O3C

               DO O4

               DO O4A

               DO O4B

               DO O97

               DO O98

               DO O99

               QUIT 

 +3        IF ONCSCMA="00510"

               DO O1

               DO O2

               DO O3

               DO O4

               DO O4A

               DO O4B

               DO O97

               DO O98

               DO O99

               QUIT 

 +4        IF (ONCSCMA="00520")!(ONCSCMA="09520")

               DO O1

               DO O1A

               DO O1A1

               DO O1A2

               DO O1B

               DO O1B1

               DO O1B2

               DO O1B3

               DO O2

               DO O2A

               DO O2A1

               DO O2A2

               DO O2B

               DO O3

               DO O3A

               DO O3B

               DO O3C

               DO O3C1

               DO O3C2

               DO O4

               DO O4A

               DO O4B

               DO O97

               DO O98

               DO O99

               QUIT 

 +5        IF (ONCSCMA="00528")!(ONCSCMA="00541")

               DO O1

               DO O1A

               DO O1B

               DO O2

               DO O2A

               DO O2B

               DO O3

               DO O3A

               DO O3B

               DO O3C

               DO O4

               DO O4A

               DO O4B

               DO O98

               DO O99

               QUIT 

 +6        IF ONCSCMA="00542"

               DO O1

               DO O1A

               DO O1B

               DO O1C

               DO O2

               DO O2A

               DO O2B

               DO O3

               DO O3A

               DO O3B

               DO O3C

               DO O4

               DO O4A

               DO O4B

               DO O98

               DO O99

               QUIT 

 +7        IF ONCSCMA="00530"

               DO O1

               DO O1A

               DO O1B

               DO O2

               DO O3

               DO O3A

               DO O3B

               DO O3C

               DO O3C1

               DO O3C2

               DO O4

               DO O4A

               DO O4B

               DO O97

               DO O98

               DO O99

               QUIT 

 +8        IF (ONCSCMA="00551")!(ONCSCMA="00552")!(ONCSCMA="00553")

               DO O1

               DO O1A

               DO O1B

               DO O1C

               DO O1C1

               DO O1C2

               DO O1C3

               DO O2

               DO O2A

               DO O2B

               DO O3

               DO O3A

               DO O3A1

               DO O3A11

               DO O3A12

               DO O3A2

               DO O3B

               DO O3C

               DO O4

               DO O4A

               DO O4B

               DO O97

               DO O98

               DO O99

               QUIT 

 +9        IF ONCSCMA="00560"

               DO O1

               DO O2

               DO O3

               DO O4

               DO O97

               DO O98

               DO O99

               QUIT 

 +10       WRITE !?4,"No FIGO Stage Codes for this Schema",!!

           KILL ONCFGLST

           QUIT 

 +11       QUIT 

 +12      ;

FIGO      ;FIGO #3836

 +1        IF "12349"'[$EXTRACT(X,1)

               KILL X

               QUIT 

 +2        IF X=9

               KILL X

               QUIT 

 +3        DO ^ONCSCHMA

           IF '$DATA(ONCSCMA)!(ONCSCMA=0)

               KILL X

               QUIT 

 +4       ;Vulva

           IF ONCSCMA="00500"

               Begin DoDot:1

 +5                IF "1^1A^1B^2^3^3A^3B^3C^4^4A^4B^97^98^99"'[X