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