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

ONCSCHMG.m

Go to the documentation of this file.
ONCSCHMG ;Hines OIFO/RTK - Grade, Discriminator, Stage Help and Utlts ;06/11/18
 ;;2.2;ONCOLOGY;**10,12**;Jul 31, 2013;Build 8
 ;
 ;
HLP ;Help for Grade fields
 D ^ONCSCHMA I ONCSCMA=0 Q
 S ONCGRIEN=$O(^ONCO(164.44,"C",ONCSCMA,"")) I ONCGRIEN="" Q
 S ONCSKNM=$O(^ONCO(164.44,ONCGRIEN,1,"B",ONCSCMA,""))
 W !?6,"Grade Table: ",$E($P($G(^ONCO(164.44,ONCGRIEN,0)),U,1),7,8)
 W ?25,"Schema: ",$P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,1),"-",$E($P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,2),1,40),!
 N IEN F IEN=0:0 S IEN=$O(^ONCO(164.44,ONCGRIEN,2,IEN)) Q:IEN'>0  D
 .W !,?2,$P($G(^ONCO(164.44,ONCGRIEN,2,IEN,0)),U,1)
 .I $L($P($G(^ONCO(164.44,ONCGRIEN,2,IEN,0)),U,2))<75 W ?6,$P($G(^ONCO(164.44,ONCGRIEN,2,IEN,0)),U,2) Q
 .W ?6,$E($P($G(^ONCO(164.44,ONCGRIEN,2,IEN,0)),U,2),1,72),!?9,$E($P($G(^ONCO(164.44,ONCGRIEN,2,IEN,0)),U,2),73,99)
 W !!
 Q
 ;
IT ;Input Transform for Grade fields
 D ^ONCSCHMA I ONCSCMA=0 Q
 S ONCGRIEN=$O(^ONCO(164.44,"C",ONCSCMA,"")) I ONCGRIEN="" Q
 S ONCGRVAL=""
 F IEN=0:0 S IEN=$O(^ONCO(164.44,ONCGRIEN,2,IEN)) Q:IEN'>0  D
 .S ONCGRVAL=ONCGRVAL_$P($G(^ONCO(164.44,ONCGRIEN,2,IEN,0)),U,1)
 I ONCGRVAL'[X K X Q
 S ONCTBIEN=$O(^ONCO(164.44,ONCGRIEN,2,"B",X,"")) I ONCTBIEN="" W "??" Q
 W "  ",$P($G(^ONCO(164.44,ONCGRIEN,2,ONCTBIEN,0)),U,2)
 K ONCGRVAL Q
 ;
OT ;Output Transform for Grade fields
 Q
 I Y="" Q
 D ^ONCSCHMA I ONCSCMA=0 Q
 N ONCGRIEN,ONCTBIEN
 S ONCGRIEN=$O(^ONCO(164.44,"C",ONCSCMA,"")) I ONCGRIEN="" Q
 S ONCTBIEN=$O(^ONCO(164.44,ONCGRIEN,2,"B",Y,"")) I ONCTBIEN="" Q
 S Y=Y_" "_$P($G(^ONCO(164.44,ONCGRIEN,2,ONCTBIEN,0)),U,2)
 Q
DSP ;Displays within Abstract Screens
 D ^ONCSCHMA I '$D(ONCSCMA) S ONCSCMA=$P($G(^ONCO(165.5,D0,"SSD1")),U,1)
 I ONCSCMA="" Q
 S ONCGRIEN=$O(^ONCO(164.44,"C",ONCSCMA,"")) I ONCGRIEN="" Q
 S ONCTBIEN=$O(^ONCO(164.44,ONCGRIEN,2,"B",ONCDGSX,"")) I ONCTBIEN="" Q
 S TXT=$P($G(^ONCO(164.44,ONCGRIEN,2,ONCTBIEN,0)),U,2)
 Q
 ;
SDHLP ;Help for Schema Discriminator fields
 D ^ONCSCHMS I ONCSCMDS=0 Q
 I '$D(ONCSDND) Q
 I ONCSDND'=1,ONCSDND'=2 Q  ;1node for SD1 2node for SD2 (SD3 not in use)
 S ONCSDIEN=$O(^ONCO(164.47,"B",ONCSCMDS,"")) I ONCSDIEN="" Q
 W !?5,"Schema ID: ",$P($G(^ONCO(164.47,ONCSDIEN,0)),U,1)
 W ?23,"Schema Name: ",$P($G(^ONCO(164.47,ONCSDIEN,0)),U,2),!
 N IEN F IEN=0:0 S IEN=$O(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN)) Q:IEN'>0  D
 .W !,?1,$P($G(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN,0)),U,1)
 .W ?4,$P($G(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN,0)),U,2)
 .I $P($G(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN,0)),U,3)'="" W !?5,$P($G(^ONCO(164.47,ONCSDIEN,1,IEN,0)),U,3)
 .I $P($G(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN,0)),U,4)'="" W !?5,$P($G(^ONCO(164.47,ONCSDIEN,1,IEN,0)),U,4)
 I ONCSDIEN=2,ONCSDND=1 W !?1,"<BLANK>  Primary Site is NOT C111, Discriminator is not necessary"
 W !!
 Q
 ;
SDIT ;Input Transform for Schema Discriminator fields
 D ^ONCSCHMS I ONCSCMDS=0 Q
 I '$D(ONCSDND) Q
 I ONCSDND'=1,ONCSDND'=2 Q  ;1node for SD1 2node for SD2 (SD3 not in use)
 S ONCSDIEN=$O(^ONCO(164.47,"B",ONCSCMDS,"")) I ONCSDIEN="" Q
 S ONCSDVAL=""
 N IEN F IEN=0:0 S IEN=$O(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN)) Q:IEN'>0  D
 .S ONCSDVAL=ONCSDVAL_$P($G(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN,0)),U,1)
 I ONCSDVAL'[X K X Q
 N IEN S IEN=$O(^ONCO(164.47,ONCSDIEN,ONCSDND,"B",X,"")) I IEN="" Q
 W "  ",$P($G(^ONCO(164.47,ONCSDIEN,ONCSDND,IEN,0)),U,2)
 K ONCSDVAL Q
 Q
 ;
SSDDSP ;
 W !," - - - - - - - - Site Specific Data Items - - - - - - - -"
 Q
SCMDSP ;Display of Schema Discriminators
 D ^ONCSCHMA I ONCSCMA=0 Q
 S ONCGRIEN=$O(^ONCO(164.44,"C",ONCSCMA,"")) I ONCGRIEN="" Q
 S ONCSKNM=$O(^ONCO(164.44,ONCGRIEN,1,"B",ONCSCMA,""))
 W !!?4,"Schema: ",$P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,1),"-",$E($P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,2),1,40),!!," - - - - - - - - - - - - - - - - - - - - - - - - - - - - -",!!
 Q
 ;
AJCCHP ;Help for AJCC TNM fields (Clin, Path, Post Therapy)
 ;CALL ONCSCHMA TO GET SCHEMA THEN GET AJCC ID FROM 164.44 SET ONCAJIEN
 ;ONCNODE SET IN INPUT TRANSFORM CALL (T=1, N=2, M=3) IF NULL QUIT
 ;
 D GTAJIEN Q:ONCAJIEN=""
 S ONCDES="",ONCCODE=""
 ; check for parent 7 nodes (chap 7-8 for 6 and 11.2-13.3 for 11.1)
 I ($G(ONCTNMTP)="P")&(ONCNODE=2)&((ONCAJIEN=2)!(ONCAJIEN=3)) S ONCAJIEN=1
 I ($G(ONCTNMTP)="P")&(ONCNODE=2) D
 .I ((ONCAJIEN=7)!(ONCAJIEN=8)!(ONCAJIEN=9)!(ONCAJIEN=10)!(ONCAJIEN=11)!(ONCAJIEN=12)!(ONCAJIEN=14)) S ONCAJIEN=6
 ; next 2 lines if Path codes differ from Clin codes switch nodes
 I $G(ONCTNMTP)="P",ONCNODE=1,$O(^ONCO(165.8,ONCAJIEN,6,0)) S ONCNODE=6
 I $G(ONCTNMTP)="P",ONCNODE=2,$O(^ONCO(165.8,ONCAJIEN,7,0)) S ONCNODE=7
 W !?1,"Chapter: ",$P($G(^ONCO(165.8,ONCAJIEN,0)),U,1)
 W ?15,"Chapter Name: ",$E($P($G(^ONCO(165.8,ONCAJIEN,0)),U,2),1,51),! I $L($P($G(^ONCO(165.8,ONCAJIEN,0)),U,2))>51 W ?29,$E($P($G(^ONCO(165.8,ONCAJIEN,0)),U,2),52,90),!
 I '$D(^ONCO(165.8,ONCAJIEN,ONCNODE)) D GETPARNT S ONCAJIEN=ONCPRIEN I ONCPRIEN="" W !!?4,"NO STAGING CODES FOR THIS CHAPTER",! K ONCTNMTP,ONCAJIEN Q
 I ($G(ONCTNMTP)="P") D CFORPATH^ONCSCHMH  ;display Clin codes for Path
 D YPCHECK^ONCSCHMH  ; yp match Path instead of Clin if 6/7 node
 N IEN F IEN=0:0 S IEN=$O(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN)) Q:IEN'>0  D
 .S ONCDES=$P($G(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN,1)),U,1)
 .S ONCCODE=$P($G(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN,0)),U,1)
 .D PRFX W !,ONCPRFX,ONCCODE D WORDWRP
 K ONCAJIEN,ONCPRIEN,ONCTNMTP,ONCCODE,ONCDES Q
 ;
WORDWRP ;Code to neatly display long descriptions
 S WRDCNT=0,STOP=0,LEN=0,LINE="",FRSTLINE=1
 F  S WRDCNT=WRDCNT+1 D  Q:STOP=1
 .S WORD=$P(ONCDES," ",WRDCNT) I WORD="" S STOP=1
 .S LEN=LEN+$L($P(ONCDES," ",WRDCNT))+1 I LEN<72 S LINE=LINE_WORD_" "
 .I LEN>71 W:FRSTLINE=0 ! W ?9,LINE S LINE="",LEN=0,WRDCNT=WRDCNT-1,FRSTLINE=0 Q
 .I WORD="" W:FRSTLINE=0 ! W ?9,LINE S LINE="",LEN=0,WRDCNT=WRDCNT-1,FRSTLINE=0
 K WRDCNT,STOP,LEN,LINE,FRSTLINE,WORD Q
 ;
AJCCIT ;Input Transform for AJCC TNM fields (Clin, Path, Post Therapy)
 ;CALL ONCSCHMA TO GET SCHEMA THEN GET AJCC ID FROM 164.44 SET ONCSDIEN
 ;ONCNODE SET IN INPUT TRANSFORM CALL (T=1, N=2, M=3) IF NULL QUIT
 ;
 I X?1"/"1.15AN1"/" S X=$P(X,"/",2) Q
 D GTAJIEN Q:ONCAJIEN=""
 ; check for parent 7 nodes (chap 7-8 for 6 and 11.2-13.3 for 11.1)
 I ($G(ONCTNMTP)="P")&(ONCNODE=2)&((ONCAJIEN=2)!(ONCAJIEN=3)) S ONCAJIEN=1
 I ($G(ONCTNMTP)="P")&(ONCNODE=2) D
 .I ((ONCAJIEN=7)!(ONCAJIEN=8)!(ONCAJIEN=9)!(ONCAJIEN=10)!(ONCAJIEN=11)!(ONCAJIEN=12)!(ONCAJIEN=14)) S ONCAJIEN=6
 ; next 2 lines if Path codes differ from Clin codes switch nodes
 I $G(ONCTNMTP)="P",ONCNODE=1,$O(^ONCO(165.8,ONCAJIEN,6,0)) S ONCNODE=6
 I $G(ONCTNMTP)="P",ONCNODE=2,$O(^ONCO(165.8,ONCAJIEN,7,0)) S ONCNODE=7
 I '$D(^ONCO(165.8,ONCAJIEN,ONCNODE)) D GETPARNT S ONCAJIEN=ONCPRIEN I ONCPRIEN="" K ONCTNMTP Q
 S ONCCODE="",ONCAJVAL="^",ONCAJLK="^"_X_"^"
 D CCODES^ONCSCHMH
 D YPCHECK^ONCSCHMH
 F IEN=0:0 S IEN=$O(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN)) Q:IEN'>0  D
 .S ONCCODE=$P($G(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN,0)),U,1)
 .D PRFX S ONCAJVAL=ONCAJVAL_ONCPRFX_ONCCODE_"^"
 D CASE
 I (ONCAJVAL'[ONCAJLK)&($P(ONCAJLK,"^",2)="cN0") S X="cN0" Q
 I (ONCAJVAL'[ONCAJLK)&($P(ONCAJLK,"^",2)="pTis") S X="pTis" Q
 I (ONCAJVAL'[ONCAJLK)&($P(ONCAJLK,"^",2)=88) S X=88 W "  Not Applicable" Q
 I ONCAJVAL'[ONCAJLK K X,ONCTNMTP Q
 S X=$P(ONCAJLK,"^",2)
 S ONCTBIEN=$O(^ONCO(165.8,ONCAJIEN,ONCNODE,"B",X,"")) I ONCTBIEN="" D  I ONCTBIEN="" K ONCTNMTP,ONCAJIEN Q
 .S ONCSIGH=$E(X,2,99) I $G(ONCTNMTP)="Y" S ONCSIGH=$E(X,3,99)
 .;I $G(ONCTNMTP)="Y",ONCAJIEN=67,((X="ypT2a")!(X="ypT2b")) S ONCSIGH=$E(X,2,99)
 .S ONCTBIEN=$O(^ONCO(165.8,ONCAJIEN,ONCNODE,"B",ONCSIGH,"")) I ONCTBIEN="" W "??" K ONCTNMTP Q
 W "  ",$E($P($G(^ONCO(165.8,ONCAJIEN,ONCNODE,ONCTBIEN,1)),U,1),1,60)
 K ONCAJVAL,ONCAJLK,ONCAJIEN,ONCTBIEN,ONCPRIEN,ONCTNMTP Q
 Q
 ;
PRFX ;set the prefix to "c" or "p" or NULL
 S ONCPRFX=""
 I (ONCCODE="")!(ONCCODE=88) Q
 ;I (ONCAJIEN=67)&($E(ONCCODE,1)="p")&($G(ONCTNMTP)="Y") S ONCPRFX="y" Q
 I ($E(ONCCODE,1)="c")!($E(ONCCODE,1)="p") Q  ;for M-Codes
 I $G(ONCTNMTP)="P" S ONCPRFX="p" Q
 I $G(ONCTNMTP)="Y" S ONCPRFX="yp" Q
 S ONCPRFX="c"
 Q
 ;
SUFFHLP ;Help for Suffix fields
 D GTAJIEN Q:ONCAJIEN=""
 I ONCSFFX="T" D
 .I ($E(ONCAJCHP,1,2)=73) W !?2,"(s)   Select if solitary tumor",!,"(m)   Select if multifocal tumor",! Q
 .W !?2,"(m)   Select if synchronous primary tumors are found in single organ",!
 .Q
 I ONCSFFX="N" D
 .W !?2,"(sn)  Select if regional lymph node metastatis identified by SLN biopsy only"
 .W !?2,"(f)   Select if regional lymph node metastatis identified by FNA or core",!,"         needle biopsy only",!
 .I (ONCAJCHP=6)!(ONCAJCHP=7)!(ONCAJCHP=8)!($E(ONCAJCHP,1,2)=11)!($E(ONCAJCHP,1,2)=12)!($E(ONCAJCHP,1,2)=13)!(ONCAJCHP=15) D
 ..W ?2,"U     Metastasis above the lower border of the cricoid",!?2,"L     Metastasis below the lower border of the cricoid",!
 .Q
 Q
SUFFIT ;Input Transform for Suffix fields
 I X?1"/"1.4AN1"/" S X=$P(X,"/",2) Q
 D GTAJIEN Q:ONCAJIEN=""
 S ONCSFXLK=X I ONCSFXLK["(" S ONCSFXLK=$P(ONCSFXLK,"(",2)
 I ONCSFXLK[")" S ONCSFXLK=$P(ONCSFXLK,")",1)
 S ONCSFXLK=$TR(ONCSFXLK,"msnful","MSNFUL")
 I ONCSFFX="T" D
 .I ONCSFXLK="M" S X="(m)" Q
 .I (ONCSFXLK="S")&($E(ONCAJCHP,1,2)=73) S X="(s)" Q
 .K X Q
 I ONCSFFX="N" D
 .I ONCSFXLK="SN" S X="(sn)" Q
 .I ONCSFXLK="F" S X="(f)" Q
 .I (ONCAJCHP=6)!(ONCAJCHP=7)!(ONCAJCHP=8)!($E(ONCAJCHP,1,2)=11)!($E(ONCAJCHP,1,2)=12)!($E(ONCAJCHP,1,2)=13)!(ONCAJCHP=15) D
 ..I ONCSFXLK="U" S X="U" Q
 ..I ONCSFXLK="L" S X="L" Q
 .K X Q
 Q
GTAJIEN ;Utility to get AJIEN, AJCC ID, AJCC CHAPTER
 S ONCAJIEN="",ONCAJID="",ONCAJCHP="",ONCAJCHN=""
 D ^ONCSCHMA I ONCSCMA=0 Q
 ;I '$D(ONCSCMA) S ONCSCMA=$P($G(^ONCO(165.5,D0,"SSD1")),U,1)
 ;I ONCSCMA=""!(ONCSCMA=0) Q
 S ONCTMP1=$O(^ONCO(164.44,"C",ONCSCMA,""))
 S ONCTMP2=$O(^ONCO(164.44,"C",ONCSCMA,ONCTMP1,""))
 S ONCAJCHP=$P($G(^ONCO(164.44,ONCTMP1,1,ONCTMP2,0)),U,3),ONCAJID=$P($G(^ONCO(164.44,ONCTMP1,1,ONCTMP2,0)),U,5) I ONCAJCHP="" S ONCAJIEN="" K ONCTMP1,ONCTMP2 Q
 D CHKAJID^ONCSCHMX S $P(^ONCO(165.5,D0,"AJCC8"),U,1)=ONCAJID
 S ONCAJIEN=$O(^ONCO(165.8,"B",ONCAJCHP,"")) I ONCAJIEN="" K ONCTMP1,ONCTMP2 Q
 S ONCAJCHN=$P($G(^ONCO(165.8,ONCAJIEN,0)),U,2)
 K ONCTMP1,ONCTMP2 Q
 ;
GETPARNT ;Utility used to get parent ptr when no T or N or M codes in 165.8
 S ONCPRIEN=""
 S ONCPARNT=$S(ONCNODE=1:3,ONCNODE=2:4,ONCNODE=3:5)
 S ONCPCHAP=$P($G(^ONCO(165.8,ONCAJIEN,0)),U,ONCPARNT) Q:ONCPCHAP=""
 S ONCPRIEN=$O(^ONCO(165.8,"B",ONCPCHAP,""))
 K ONCPARNT,ONCPCHAP Q
 ;
CASE ;Utility for allowing any case in input of TNM fields
 S ONCAJLK=X
 S ONCAJLK=$TR(ONCAJLK,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 N PFX S PFX="c" I $G(ONCTNMTP)="P" S PFX="p"
 I $G(ONCTNMTP)="Y" S PFX="yp"
 I ONCAJLK["LAMN" S ONCAJLK="^"_PFX_"Tis(LAMN)^" Q
 I (ONCAJIEN=52)&(ONCAJLK="CTIS")&(PFX="c") D  Q
 .W !?2,"1   cTis(DCIS)  - Ductal carcinoma in situ",!?2,"2   cTis(Paget) - Paget disease of nipple NOT associated w/inv carcinoma"
 .N ONCZZZ R !,"CHOOSE 1-2:  ",ONCZZZ:DTIME
 .I ONCZZZ=1 S ONCAJLK="^"_PFX_"Tis(DCIS)^" Q
 .I ONCZZZ=2 S ONCAJLK="^"_PFX_"Tis(Paget)^" Q
 I (ONCAJIEN=52)&(ONCAJLK="PTIS")&(PFX="p") D  Q
 .W !?2,"1   pTis(DCIS)  - Ductal carcinoma in situ",!?2,"2   pTis(Paget) - Paget disease of nipple NOT associated w/inv carcinoma"
 .N ONCZZZ R !,"CHOOSE 1-2:  ",ONCZZZ:DTIME
 .I ONCZZZ=1 S ONCAJLK="^"_PFX_"Tis(DCIS)^" Q
 .I ONCZZZ=2 S ONCAJLK="^"_PFX_"Tis(Paget)^" Q
 I ONCAJLK["DCIS" S ONCAJLK="^"_PFX_"Tis(DCIS)^" Q
 I ONCAJLK["PAGET" S ONCAJLK="^"_PFX_"Tis(Paget)^" Q
 I ONCAJLK["MOL+" S ONCZX=$S(ONCNODE=1:"T",ONCNODE=6:"T",ONCNODE=2:"N",ONCNODE=7:"N",1:"M") S ONCAJLK="^"_PFX_ONCZX_"0(mol+)^" K PFX,ONCZX Q
 I ONCAJLK["I+" S ONCZX=$S(ONCNODE=1:"T",ONCNODE=6:"T",ONCNODE=2:"N",ONCNODE=7:"N",1:"M") S ONCAJLK="^"_PFX_ONCZX_"0(i+)^" K PFX,ONCZX Q
 I ONCAJLK["MI" S ONCAJLK=$TR(ONCAJLK,"CPY","cpy") S ONCAJLK="^"_$P(ONCAJLK,"MI",1)_"mi^"_$P(ONCAJLK,"MI^",2,7) Q
 S ONCAJLK=$TR(ONCAJLK,"ABCDEISPY","abcdeispy")
 S ONCAJLK="^"_ONCAJLK_"^"
 Q