ONCSCHMT ;HINES OIFO/RTK - TEMPLATE JUMPING BASED ON SCHEMA CODE ;09/11/18
;;2.2;ONCOLOGY;**10,13,15,17,18**;Jul 31, 2013;Build 5
;
S ONCTJUMP=0
;
I '$D(ONCSCMA) S Y="@98765" Q
I ONCSCMA=0 S Y="@98765" Q ;if SCHEMA not determined skip ALL SSDi
;
I "00060^00140"[ONCSCMA S Y="@00060" Q
I "00071^00072^00073^00074^00075^00076^00077^00100^00111^00112"[ONCSCMA S Y="@00060",ONCTJUMP=71 Q ;same as 00060 but then JUMP over last 4
I "00080^00090^00121^00122^00130^00131^00132^00133"[ONCSCMA S Y="@00060",ONCTJUMP=80 Q
;
I "00150"[ONCSCMA S Y="@00150" Q
I "00161"[ONCSCMA S Y="@00161" Q
I "00169^00170"[ONCSCMA S Y="@00169" Q
I "00190"[ONCSCMA S Y="@00190" Q
I "09190"[ONCSCMA S Y="@00190",ONCTJUMP=9190 Q
I "00200"[ONCSCMA S Y="@00190",ONCTJUMP=200 Q
I "00220"[ONCSCMA S Y="@00220" Q
I "00230"[ONCSCMA S Y="@00220",ONCTJUMP=230 Q
I "00250"[ONCSCMA S Y="@00250" Q
I "00280"[ONCSCMA S Y="@00280" Q
I "00290^00301^00302^00310^00320^00330^00340^"[ONCSCMA S Y="@00290" Q
I "00360"[ONCSCMA S Y="@00360" Q
I "00370"[ONCSCMA S Y="@00370" Q
I "00381^00382^00383"[ONCSCMA S Y="@00381" Q
I "00400^00410^00421^00422^00440^00450^00459"[ONCSCMA S Y="@00400" Q
I "00430"[ONCSCMA S Y="@00430" Q
I "00460"[ONCSCMA S Y="@00460" Q
I "00470"[ONCSCMA S Y="@00470" Q
I "00480"[ONCSCMA S Y="@00480" Q
;I "00500"[ONCSCMA S Y="@00500" Q ;THIS LINE & NEXT WILL BE REPLACED P17
;I "00510^00520^09520"[ONCSCMA S Y="@00500",ONCTJUMP=510 Q
I "00500"[ONCSCMA S Y="@00500",ONCTJUMP=500 Q ;THESE 4 LINES FOR P17
I "00510"[ONCSCMA S Y="@00500",ONCTJUMP=510 Q
I "00520"[ONCSCMA S Y="@00500",ONCTJUMP=520 Q
I "09520"[ONCSCMA S Y="@00500",ONCTJUMP=5209 Q
I "09210"[ONCSCMA S Y=3956,ONCTJUMP=210 Q
I "00528^00530^00541^00542"[ONCSCMA S Y="@00530" Q
I "00551^00552^00553"[ONCSCMA S Y="@00551" Q
I "00560"[ONCSCMA S Y="@00551",ONCTJUMP=560 Q
I "00570"[ONCSCMA S Y="@00570" Q
I "00580"[ONCSCMA S Y="@00580" Q
I "00590"[ONCSCMA S Y="@00590" Q
I "00600"[ONCSCMA S Y="@00600" Q
I "00640"[ONCSCMA S Y="@00640" Q
I "00660"[ONCSCMA S Y="@00660" Q
I "00671^00672"[ONCSCMA S Y="@00660",ONCTJUMP=671 Q
I "00680"[ONCSCMA S Y="@00680" Q
I "00690"[ONCSCMA S Y="@00690" Q
I "00721^09721^00722^09722"[ONCSCMA S Y="@00721" Q
I "09724"[ONCSCMA S Y="@00721",ONCTJUMP=9724 Q
I "00790"[ONCSCMA S Y="@00790" Q
I "00795"[ONCSCMA S Y="@00790",ONCTJUMP=795 Q
I "00811"[ONCSCMA S Y="@00811" Q
I "00821"[ONCSCMA S Y="@00821" Q
I "00830"[ONCSCMA S Y="@00830" Q
;
I "00118^00119^00128^00180^00210^00241^00270^00278^00288"[ONCSCMA S Y="@98765" Q ;these have no SSDi except Grade
I "00350^00358^00378^00458^00478^00558^00559^00598^00610^00620^00631^00633^00638"[ONCSCMA S Y="@98765" Q ;these have no SSDi except Grade
I "00650^00698^00700^00710^00718^00723^09723^00730^00740^00750^00760^00770^00778^00812^00822^99999"[ONCSCMA S Y="@98765" Q ;these have no SSDi except Grade
I "00242^00260"[ONCSCMA S Y="@98765" Q ;only Schema Disc & Grade
;
Q
TMP1 ;Utility to display chapters/names/codes in string set below
F ONCSDIEN=1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,21,52 D TMP1SUB
Q
TMP1SUB W !?1,"Chapter: ",$P($G(^ONCO(165.8,ONCSDIEN,0)),U,1)
W ?15,"Chapter Name: ",$E($P($G(^ONCO(165.8,ONCSDIEN,0)),U,2),1,51),! I $L($P($G(^ONCO(165.8,ONCSDIEN,0)),U,2))>51 W ?29,$E($P($G(^ONCO(165.8,ONCSDIEN,0)),U,2),52,90),!
N IEN F IEN=0:0 S IEN=$O(^ONCO(165.8,ONCSDIEN,1,IEN)) Q:IEN'>0 D
.S ONCTXL=$L($P($G(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1))
.W !,$P($G(^ONCO(165.8,ONCSDIEN,1,IEN,0)),U,1)
.W ?6,$E($P($G(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),1,74) I ONCTXL>74 W !?7,$E($P($G(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),75,147) I ONCTXL>147 W !?7,$E($P($G(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),148,222)
.I ONCTXL>222 W !?7,$E($P($G(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),223,297) I ONCTXL>297 W !?7,$E($P($G(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),298,334)
Q
;
TMP2 ;Utility to display very long character strings
S ABC=0,STOP=0,LEN=0,LINE="",N123=$P($G(^ONCO(165.8,1,2,4,1)),"^",1)
W !,N123,!
F S ABC=ABC+1 D Q:STOP=1
.S WORD=$P(N123," ",ABC) I WORD="" S STOP=1
.S LEN=LEN+$L($P(N123," ",ABC))+1 I LEN<72 S LINE=LINE_WORD_" "
.I LEN>71 W !?9,LINE S LINE="",LEN=0,ABC=ABC-1
.I WORD="" W !?9,LINE S LINE="",LEN=0,ABC=ABC-1
Q
TMP3 ;Utility to display the Chapter and AJCC ID
S IEN=0 F S IEN=$O(^ONCO(164.44,IEN)) Q:IEN'>0 D
.S SUBIEN=0 F S SUBIEN=$O(^ONCO(164.44,IEN,1,SUBIEN)) Q:SUBIEN'>0 D
..W !,?1,IEN,?5,SUBIEN,?9,"CHAP=",$P($G(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",3),?21,"ID=",$P($G(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",5)
Q
NOAJCC ;Utility to find/display Grade tables & AJCC ID/Chapter
N IEN F IEN=0:0 S IEN=$O(^ONCO(164.44,IEN)) Q:IEN'>0 D
.N SUBIEN F SUBIEN=0:0 S SUBIEN=$O(^ONCO(164.44,IEN,1,SUBIEN)) Q:SUBIEN'>0 D
..W !,IEN W ?5,"SCHEMA ID=",$P($G(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",1)," AJCC CHAPTER #=",$P($G(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",3)," AJCC ID=",$P($G(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",5)
Q
FINDTS ;Utility to find 165.8 entries without T codes --> these use Parent ptr
N AJIEN F AJIEN=0:0 S AJIEN=$O(^ONCO(165.8,AJIEN)) Q:AJIEN'>0 D
.I '$D(^ONCO(165.8,AJIEN,1,1,0)) W !,$P($G(^ONCO(165.8,AJIEN,0)),U,1)," --> NO STAGE CODES" D
..I $P($G(^ONCO(165.8,AJIEN,0)),U,3)'="" W "...USE " S ONCPARNT=$P($G(^ONCO(165.8,AJIEN,0)),U,3) W " ",ONCPARNT S ONCAJIEN=$O(^ONCO(165.8,"B",ONCPARNT,"")) W " --> ",ONCAJIEN
Q
FINDNS ;Utility to find 165.8 entries without N codes --> these use Parent ptr
N AJIEN F AJIEN=0:0 S AJIEN=$O(^ONCO(165.8,AJIEN)) Q:AJIEN'>0 D
.I '$D(^ONCO(165.8,AJIEN,2,1,0)) W !,$P($G(^ONCO(165.8,AJIEN,0)),U,1)," --> NO STAGE CODES" D
..I $P($G(^ONCO(165.8,AJIEN,0)),U,4)'="" W "...USE " S ONCPARNT=$P($G(^ONCO(165.8,AJIEN,0)),U,4) W " ",ONCPARNT S ONCAJIEN=$O(^ONCO(165.8,"B",ONCPARNT,"")) W " --> ",ONCAJIEN
Q
FINDMS ;Utility to find 165.8 entries without M codes --> these use Parent ptr
N AJIEN F AJIEN=0:0 S AJIEN=$O(^ONCO(165.8,AJIEN)) Q:AJIEN'>0 D
.I '$D(^ONCO(165.8,AJIEN,3,1,0)) W !,$P($G(^ONCO(165.8,AJIEN,0)),U,1)," --> NO STAGE CODES" D
..I $P($G(^ONCO(165.8,AJIEN,0)),U,5)'="" W "...USE " S ONCPARNT=$P($G(^ONCO(165.8,AJIEN,0)),U,5) W " ",ONCPARNT S ONCAJIEN=$O(^ONCO(165.8,"B",ONCPARNT,"")) W " --> ",ONCAJIEN
Q
LISTAJ ;List the AJCC Chapter/ID and which entry in File #165.8 it points to
N GRIEN F GRIEN=0:0 S GRIEN=$O(^ONCO(164.44,GRIEN)) Q:GRIEN'>0 D
.N SBIEN F SBIEN=0:0 S SBIEN=$O(^ONCO(164.44,GRIEN,1,SBIEN)) Q:SBIEN'>0 D
..W !,"GRADE=",GRIEN,?10,"SCHEMA=",$P($G(^ONCO(164.44,GRIEN,1,SBIEN,0)),U,1)
..S AJCHP=$P($G(^ONCO(164.44,GRIEN,1,SBIEN,0)),U,3) W ?24,"AJCHP=",AJCHP
..S AJIEN=$P($G(^ONCO(164.44,GRIEN,1,SBIEN,0)),U,5) W ?36,"AJIEN=",AJIEN
..I AJCHP="" Q
..S AJ1658=$O(^ONCO(165.8,"B",AJCHP,"")) W ?47,"CHAP=",AJ1658
..S AJCHN=$P($G(^ONCO(165.8,AJ1658,0)),U,2) W ?56,">",$E(AJCHN,1,23)
.Q
Q
TESTEOD ;Utility to find 165.9 entries without HELP codes
N EOIEN F EOIEN=0:0 S EOIEN=$O(^ONCO(165.9,EOIEN)) Q:EOIEN'>0 D
.W !,EOIEN," ",$P($G(^ONCO(165.9,EOIEN,0)),U,1),"--",$P($G(^ONCO(165.9,EOIEN,0)),U,2)
.I '$D(^ONCO(165.9,EOIEN,1)) W "----> NO PT !!!!" H 1
.I '$D(^ONCO(165.9,EOIEN,2)) W "----> NO RN !!!!" H 1
.I '$D(^ONCO(165.9,EOIEN,3)) W "----> NO MT !!!!" H 1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSCHMT 7291 printed Dec 13, 2024@02:28:06 Page 2
ONCSCHMT ;HINES OIFO/RTK - TEMPLATE JUMPING BASED ON SCHEMA CODE ;09/11/18
+1 ;;2.2;ONCOLOGY;**10,13,15,17,18**;Jul 31, 2013;Build 5
+2 ;
+3 SET ONCTJUMP=0
+4 ;
+5 IF '$DATA(ONCSCMA)
SET Y="@98765"
QUIT
+6 ;if SCHEMA not determined skip ALL SSDi
IF ONCSCMA=0
SET Y="@98765"
QUIT
+7 ;
+8 IF "00060^00140"[ONCSCMA
SET Y="@00060"
QUIT
+9 ;same as 00060 but then JUMP over last 4
IF "00071^00072^00073^00074^00075^00076^00077^00100^00111^00112"[ONCSCMA
SET Y="@00060"
SET ONCTJUMP=71
QUIT
+10 IF "00080^00090^00121^00122^00130^00131^00132^00133"[ONCSCMA
SET Y="@00060"
SET ONCTJUMP=80
QUIT
+11 ;
+12 IF "00150"[ONCSCMA
SET Y="@00150"
QUIT
+13 IF "00161"[ONCSCMA
SET Y="@00161"
QUIT
+14 IF "00169^00170"[ONCSCMA
SET Y="@00169"
QUIT
+15 IF "00190"[ONCSCMA
SET Y="@00190"
QUIT
+16 IF "09190"[ONCSCMA
SET Y="@00190"
SET ONCTJUMP=9190
QUIT
+17 IF "00200"[ONCSCMA
SET Y="@00190"
SET ONCTJUMP=200
QUIT
+18 IF "00220"[ONCSCMA
SET Y="@00220"
QUIT
+19 IF "00230"[ONCSCMA
SET Y="@00220"
SET ONCTJUMP=230
QUIT
+20 IF "00250"[ONCSCMA
SET Y="@00250"
QUIT
+21 IF "00280"[ONCSCMA
SET Y="@00280"
QUIT
+22 IF "00290^00301^00302^00310^00320^00330^00340^"[ONCSCMA
SET Y="@00290"
QUIT
+23 IF "00360"[ONCSCMA
SET Y="@00360"
QUIT
+24 IF "00370"[ONCSCMA
SET Y="@00370"
QUIT
+25 IF "00381^00382^00383"[ONCSCMA
SET Y="@00381"
QUIT
+26 IF "00400^00410^00421^00422^00440^00450^00459"[ONCSCMA
SET Y="@00400"
QUIT
+27 IF "00430"[ONCSCMA
SET Y="@00430"
QUIT
+28 IF "00460"[ONCSCMA
SET Y="@00460"
QUIT
+29 IF "00470"[ONCSCMA
SET Y="@00470"
QUIT
+30 IF "00480"[ONCSCMA
SET Y="@00480"
QUIT
+31 ;I "00500"[ONCSCMA S Y="@00500" Q ;THIS LINE & NEXT WILL BE REPLACED P17
+32 ;I "00510^00520^09520"[ONCSCMA S Y="@00500",ONCTJUMP=510 Q
+33 ;THESE 4 LINES FOR P17
IF "00500"[ONCSCMA
SET Y="@00500"
SET ONCTJUMP=500
QUIT
+34 IF "00510"[ONCSCMA
SET Y="@00500"
SET ONCTJUMP=510
QUIT
+35 IF "00520"[ONCSCMA
SET Y="@00500"
SET ONCTJUMP=520
QUIT
+36 IF "09520"[ONCSCMA
SET Y="@00500"
SET ONCTJUMP=5209
QUIT
+37 IF "09210"[ONCSCMA
SET Y=3956
SET ONCTJUMP=210
QUIT
+38 IF "00528^00530^00541^00542"[ONCSCMA
SET Y="@00530"
QUIT
+39 IF "00551^00552^00553"[ONCSCMA
SET Y="@00551"
QUIT
+40 IF "00560"[ONCSCMA
SET Y="@00551"
SET ONCTJUMP=560
QUIT
+41 IF "00570"[ONCSCMA
SET Y="@00570"
QUIT
+42 IF "00580"[ONCSCMA
SET Y="@00580"
QUIT
+43 IF "00590"[ONCSCMA
SET Y="@00590"
QUIT
+44 IF "00600"[ONCSCMA
SET Y="@00600"
QUIT
+45 IF "00640"[ONCSCMA
SET Y="@00640"
QUIT
+46 IF "00660"[ONCSCMA
SET Y="@00660"
QUIT
+47 IF "00671^00672"[ONCSCMA
SET Y="@00660"
SET ONCTJUMP=671
QUIT
+48 IF "00680"[ONCSCMA
SET Y="@00680"
QUIT
+49 IF "00690"[ONCSCMA
SET Y="@00690"
QUIT
+50 IF "00721^09721^00722^09722"[ONCSCMA
SET Y="@00721"
QUIT
+51 IF "09724"[ONCSCMA
SET Y="@00721"
SET ONCTJUMP=9724
QUIT
+52 IF "00790"[ONCSCMA
SET Y="@00790"
QUIT
+53 IF "00795"[ONCSCMA
SET Y="@00790"
SET ONCTJUMP=795
QUIT
+54 IF "00811"[ONCSCMA
SET Y="@00811"
QUIT
+55 IF "00821"[ONCSCMA
SET Y="@00821"
QUIT
+56 IF "00830"[ONCSCMA
SET Y="@00830"
QUIT
+57 ;
+58 ;these have no SSDi except Grade
IF "00118^00119^00128^00180^00210^00241^00270^00278^00288"[ONCSCMA
SET Y="@98765"
QUIT
+59 ;these have no SSDi except Grade
IF "00350^00358^00378^00458^00478^00558^00559^00598^00610^00620^00631^00633^00638"[ONCSCMA
SET Y="@98765"
QUIT
+60 ;these have no SSDi except Grade
IF "00650^00698^00700^00710^00718^00723^09723^00730^00740^00750^00760^00770^00778^00812^00822^99999"[ONCSCMA
SET Y="@98765"
QUIT
+61 ;only Schema Disc & Grade
IF "00242^00260"[ONCSCMA
SET Y="@98765"
QUIT
+62 ;
+63 QUIT
TMP1 ;Utility to display chapters/names/codes in string set below
+1 FOR ONCSDIEN=1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,21,52
DO TMP1SUB
+2 QUIT
TMP1SUB WRITE !?1,"Chapter: ",$PIECE($GET(^ONCO(165.8,ONCSDIEN,0)),U,1)
+1 WRITE ?15,"Chapter Name: ",$EXTRACT($PIECE($GET(^ONCO(165.8,ONCSDIEN,0)),U,2),1,51),!
IF $LENGTH($PIECE($GET(^ONCO(165.8,ONCSDIEN,0)),U,2))>51
WRITE ?29,$EXTRACT($PIECE($GET(^ONCO(165.8,ONCSDIEN,0)),U,2),52,90),!
+2 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.8,ONCSDIEN,1,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET ONCTXL=$LENGTH($PIECE($GET(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1))
+4 WRITE !,$PIECE($GET(^ONCO(165.8,ONCSDIEN,1,IEN,0)),U,1)
+5 WRITE ?6,$EXTRACT($PIECE($GET(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),1,74)
IF ONCTXL>74
WRITE !?7,$EXTRACT($PIECE($GET(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),75,147)
IF ONCTXL>147
WRITE !?7,$EXTRACT($PIECE($GET(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),148,222)
+6 IF ONCTXL>222
WRITE !?7,$EXTRACT($PIECE($GET(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),223,297)
IF ONCTXL>297
WRITE !?7,$EXTRACT($PIECE($GET(^ONCO(165.8,ONCSDIEN,1,IEN,1)),U,1),298,334)
End DoDot:1
+7 QUIT
+8 ;
TMP2 ;Utility to display very long character strings
+1 SET ABC=0
SET STOP=0
SET LEN=0
SET LINE=""
SET N123=$PIECE($GET(^ONCO(165.8,1,2,4,1)),"^",1)
+2 WRITE !,N123,!
+3 FOR
SET ABC=ABC+1
Begin DoDot:1
+4 SET WORD=$PIECE(N123," ",ABC)
IF WORD=""
SET STOP=1
+5 SET LEN=LEN+$LENGTH($PIECE(N123," ",ABC))+1
IF LEN<72
SET LINE=LINE_WORD_" "
+6 IF LEN>71
WRITE !?9,LINE
SET LINE=""
SET LEN=0
SET ABC=ABC-1
+7 IF WORD=""
WRITE !?9,LINE
SET LINE=""
SET LEN=0
SET ABC=ABC-1
End DoDot:1
if STOP=1
QUIT
+8 QUIT
TMP3 ;Utility to display the Chapter and AJCC ID
+1 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(164.44,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+2 SET SUBIEN=0
FOR
SET SUBIEN=$ORDER(^ONCO(164.44,IEN,1,SUBIEN))
if SUBIEN'>0
QUIT
Begin DoDot:2
+3 WRITE !,?1,IEN,?5,SUBIEN,?9,"CHAP=",$PIECE($GET(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",3),?21,"ID=",$PIECE($GET(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",5)
End DoDot:2
End DoDot:1
+4 QUIT
NOAJCC ;Utility to find/display Grade tables & AJCC ID/Chapter
+1 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(164.44,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+2 NEW SUBIEN
FOR SUBIEN=0:0
SET SUBIEN=$ORDER(^ONCO(164.44,IEN,1,SUBIEN))
if SUBIEN'>0
QUIT
Begin DoDot:2
+3 WRITE !,IEN
WRITE ?5,"SCHEMA ID=",$PIECE($GET(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",1)," AJCC CHAPTER #=",$PIECE($GET(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",3)," AJCC ID=",$PIECE($GET(^ONCO(164.44,IEN,1,SUBIEN,0)),"^",5)
End DoDot:2
End DoDot:1
+4 QUIT
FINDTS ;Utility to find 165.8 entries without T codes --> these use Parent ptr
+1 NEW AJIEN
FOR AJIEN=0:0
SET AJIEN=$ORDER(^ONCO(165.8,AJIEN))
if AJIEN'>0
QUIT
Begin DoDot:1
+2 IF '$DATA(^ONCO(165.8,AJIEN,1,1,0))
WRITE !,$PIECE($GET(^ONCO(165.8,AJIEN,0)),U,1)," --> NO STAGE CODES"
Begin DoDot:2
+3 IF $PIECE($GET(^ONCO(165.8,AJIEN,0)),U,3)'=""
WRITE "...USE "
SET ONCPARNT=$PIECE($GET(^ONCO(165.8,AJIEN,0)),U,3)
WRITE " ",ONCPARNT
SET ONCAJIEN=$ORDER(^ONCO(165.8,"B",ONCPARNT,""))
WRITE " --> ",ONCAJIEN
End DoDot:2
End DoDot:1
+4 QUIT
FINDNS ;Utility to find 165.8 entries without N codes --> these use Parent ptr
+1 NEW AJIEN
FOR AJIEN=0:0
SET AJIEN=$ORDER(^ONCO(165.8,AJIEN))
if AJIEN'>0
QUIT
Begin DoDot:1
+2 IF '$DATA(^ONCO(165.8,AJIEN,2,1,0))
WRITE !,$PIECE($GET(^ONCO(165.8,AJIEN,0)),U,1)," --> NO STAGE CODES"
Begin DoDot:2
+3 IF $PIECE($GET(^ONCO(165.8,AJIEN,0)),U,4)'=""
WRITE "...USE "
SET ONCPARNT=$PIECE($GET(^ONCO(165.8,AJIEN,0)),U,4)
WRITE " ",ONCPARNT
SET ONCAJIEN=$ORDER(^ONCO(165.8,"B",ONCPARNT,""))
WRITE " --> ",ONCAJIEN
End DoDot:2
End DoDot:1
+4 QUIT
FINDMS ;Utility to find 165.8 entries without M codes --> these use Parent ptr
+1 NEW AJIEN
FOR AJIEN=0:0
SET AJIEN=$ORDER(^ONCO(165.8,AJIEN))
if AJIEN'>0
QUIT
Begin DoDot:1
+2 IF '$DATA(^ONCO(165.8,AJIEN,3,1,0))
WRITE !,$PIECE($GET(^ONCO(165.8,AJIEN,0)),U,1)," --> NO STAGE CODES"
Begin DoDot:2
+3 IF $PIECE($GET(^ONCO(165.8,AJIEN,0)),U,5)'=""
WRITE "...USE "
SET ONCPARNT=$PIECE($GET(^ONCO(165.8,AJIEN,0)),U,5)
WRITE " ",ONCPARNT
SET ONCAJIEN=$ORDER(^ONCO(165.8,"B",ONCPARNT,""))
WRITE " --> ",ONCAJIEN
End DoDot:2
End DoDot:1
+4 QUIT
LISTAJ ;List the AJCC Chapter/ID and which entry in File #165.8 it points to
+1 NEW GRIEN
FOR GRIEN=0:0
SET GRIEN=$ORDER(^ONCO(164.44,GRIEN))
if GRIEN'>0
QUIT
Begin DoDot:1
+2 NEW SBIEN
FOR SBIEN=0:0
SET SBIEN=$ORDER(^ONCO(164.44,GRIEN,1,SBIEN))
if SBIEN'>0
QUIT
Begin DoDot:2
+3 WRITE !,"GRADE=",GRIEN,?10,"SCHEMA=",$PIECE($GET(^ONCO(164.44,GRIEN,1,SBIEN,0)),U,1)
+4 SET AJCHP=$PIECE($GET(^ONCO(164.44,GRIEN,1,SBIEN,0)),U,3)
WRITE ?24,"AJCHP=",AJCHP
+5 SET AJIEN=$PIECE($GET(^ONCO(164.44,GRIEN,1,SBIEN,0)),U,5)
WRITE ?36,"AJIEN=",AJIEN
+6 IF AJCHP=""
QUIT
+7 SET AJ1658=$ORDER(^ONCO(165.8,"B",AJCHP,""))
WRITE ?47,"CHAP=",AJ1658
+8 SET AJCHN=$PIECE($GET(^ONCO(165.8,AJ1658,0)),U,2)
WRITE ?56,">",$EXTRACT(AJCHN,1,23)
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
TESTEOD ;Utility to find 165.9 entries without HELP codes
+1 NEW EOIEN
FOR EOIEN=0:0
SET EOIEN=$ORDER(^ONCO(165.9,EOIEN))
if EOIEN'>0
QUIT
Begin DoDot:1
+2 WRITE !,EOIEN," ",$PIECE($GET(^ONCO(165.9,EOIEN,0)),U,1),"--",$PIECE($GET(^ONCO(165.9,EOIEN,0)),U,2)
+3 IF '$DATA(^ONCO(165.9,EOIEN,1))
WRITE "----> NO PT !!!!"
HANG 1
+4 IF '$DATA(^ONCO(165.9,EOIEN,2))
WRITE "----> NO RN !!!!"
HANG 1
+5 IF '$DATA(^ONCO(165.9,EOIEN,3))
WRITE "----> NO MT !!!!"
HANG 1
End DoDot:1
+6 QUIT
