Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCSCHMM

ONCSCHMM.m

Go to the documentation of this file. 
ONCSCHMM ;HINES OIFO/RTK - Miscellaneous schema code ;07/25/19

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

 ;

 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^09500^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

SCRCASRC ;Screen for field #21 Casefinding Source

 I (Y=20)!(Y=21)!(Y=22)!(Y=23)!(Y=24)!(Y=25)!(Y=26)!(Y=27)!(Y=29)!(Y=80)!(Y=95) 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")!(ONCSCMA="09500") 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")!(ONCSCMA="09500") 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