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