ONCSCHMG ;HINES OIFO/RTK - Grade, Discriminator, Stage Help and Utlts ;06/11/18
;;2.2;ONCOLOGY;**10,12,13,14,20,21**;Jul 31, 2013;Build 6
;
;
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),!
W !?5,"Chapter Name: ",$E($P($G(^ONCO(165.8,ONCAJIEN,0)),U,2),1,75)
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 AJCCV9^ONCSCHMN S $P(^ONCO(165.5,D0,"AJCC8"),U,1)=ONCAJID ;check V9 (9xxx)
D CHKAJID^ONCSCHMX S $P(^ONCO(165.5,D0,"AJCC8"),U,1)=ONCAJID ;check "XX"
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 12193 printed Sep 23, 2025@20:04:07 Page 2
ONCSCHMG ;HINES OIFO/RTK - Grade, Discriminator, Stage Help and Utlts ;06/11/18
+1 ;;2.2;ONCOLOGY;**10,12,13,14,20,21**;Jul 31, 2013;Build 6
+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 ;W !?1,"Chapter: ",$P($G(^ONCO(165.8,ONCAJIEN,0)),U,1)
+15 ;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),!
+16 WRITE !?5,"Chapter Name: ",$EXTRACT($PIECE($GET(^ONCO(165.8,ONCAJIEN,0)),U,2),1,75)
+17 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
+18 ;display Clin codes for Path
IF ($GET(ONCTNMTP)="P")
DO CFORPATH^ONCSCHMH
+19 ; yp match Path instead of Clin if 6/7 node
DO YPCHECK^ONCSCHMH
+20 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+21 SET ONCDES=$PIECE($GET(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN,1)),U,1)
+22 SET ONCCODE=$PIECE($GET(^ONCO(165.8,ONCAJIEN,ONCNODE,IEN,0)),U,1)
+23 DO PRFX
WRITE !,ONCPRFX,ONCCODE
DO WORDWRP
End DoDot:1
+24 KILL ONCAJIEN,ONCPRIEN,ONCTNMTP,ONCYC,ONCCODE,ONCDES
QUIT
+25 ;
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 ;check V9 (9xxx)
DO AJCCV9^ONCSCHMN
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,1)=ONCAJID
+9 ;check "XX"
DO CHKAJID^ONCSCHMX
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,1)=ONCAJID
+10 SET ONCAJIEN=$ORDER(^ONCO(165.8,"B",ONCAJCHP,""))
IF ONCAJIEN=""
KILL ONCTMP1,ONCTMP2
QUIT
+11 SET ONCAJCHN=$PIECE($GET(^ONCO(165.8,ONCAJIEN,0)),U,2)
+12 KILL ONCTMP1,ONCTMP2
QUIT
+13 ;
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
