ONCODGR ;WASH ISC/SRR-DD for GRADE: #24;file 165.5 ;2/9/93 15:11
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
SS S S=$P(^ONCO(165.5,D0,0),U) S SS=$S(S=63:62,(S>65&(S<70)):68,S=40:62,S'=62:36,1:S)
Q
IN ;CHECK INPUT GRADE #24;165.5
D SS S Y=$O(^ONCO(164.2,SS,"G","X",X,0)) I Y="" K X Q
S Y=^ONCO(164.2,SS,"G",Y,0) W ?15,$P(Y,U)_" "_$P(Y,U,2) K Y G EX
K X,Y G EX
Q
;
OT ;OUTPUT TRANSFORM for N0 CANCER-DIRECTED/SITE SPECIFIC surgery #58.1
Q:Y="" D SS S X=$O(^ONCO(164.2,SS,"G","X",Y,0)) G EX:X="" S X=^ONCO(164.2,SS,"G",X,0),Y=$P(X,U)_" "_$P(X,U,2) G EX
;
HP ;EXTENDED HELP for GRADE #24 (FILE 165.5)
K DIR I X="??" S XQH="ONCO GRADE" D EN^XQH W !!
D SS S Y=0 F S Y=$O(^ONCO(164.2,SS,"G",Y)) Q:Y="B" S X=^(Y,0) W ?10,$P(X,U,3)_"-"_$P(X,U)_" "_$P(X,U,2),!
W !?5,"Enter a 1-digit code from above list.",! G EX
;
GA() ; Computation for GRADE ABBREVIATION Field (#25)
; in ONCOLOGY PRIMARY File (#165.5)
;
S X=$P($G(^ONCO(165.5,D0,2)),U,5)
S X=$S(X=1:"WD",X=2:"MD",X=3:"PD",X=4:"ANA",X=5:"T-CELL",X=6:"B-CELL",X=7:"NULL-CELL",1:"")
Q X
;
EX ;EXIT
K SS Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCODGR 1105 printed Sep 23, 2025@20:00:53 Page 2
ONCODGR ;WASH ISC/SRR-DD for GRADE: #24;file 165.5 ;2/9/93 15:11
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
SS SET S=$PIECE(^ONCO(165.5,D0,0),U)
SET SS=$SELECT(S=63:62,(S>65&(S<70)):68,S=40:62,S'=62:36,1:S)
+1 QUIT
IN ;CHECK INPUT GRADE #24;165.5
+1 DO SS
SET Y=$ORDER(^ONCO(164.2,SS,"G","X",X,0))
IF Y=""
KILL X
QUIT
+2 SET Y=^ONCO(164.2,SS,"G",Y,0)
WRITE ?15,$PIECE(Y,U)_" "_$PIECE(Y,U,2)
KILL Y
GOTO EX
+3 KILL X,Y
GOTO EX
+4 QUIT
+5 ;
OT ;OUTPUT TRANSFORM for N0 CANCER-DIRECTED/SITE SPECIFIC surgery #58.1
+1 if Y=""
QUIT
DO SS
SET X=$ORDER(^ONCO(164.2,SS,"G","X",Y,0))
if X=""
GOTO EX
SET X=^ONCO(164.2,SS,"G",X,0)
SET Y=$PIECE(X,U)_" "_$PIECE(X,U,2)
GOTO EX
+2 ;
HP ;EXTENDED HELP for GRADE #24 (FILE 165.5)
+1 KILL DIR
IF X="??"
SET XQH="ONCO GRADE"
DO EN^XQH
WRITE !!
+2 DO SS
SET Y=0
FOR
SET Y=$ORDER(^ONCO(164.2,SS,"G",Y))
if Y="B"
QUIT
SET X=^(Y,0)
WRITE ?10,$PIECE(X,U,3)_"-"_$PIECE(X,U)_" "_$PIECE(X,U,2),!
+3 WRITE !?5,"Enter a 1-digit code from above list.",!
GOTO EX
+4 ;
GA() ; Computation for GRADE ABBREVIATION Field (#25)
+1 ; in ONCOLOGY PRIMARY File (#165.5)
+2 ;
+3 SET X=$PIECE($GET(^ONCO(165.5,D0,2)),U,5)
+4 SET X=$SELECT(X=1:"WD",X=2:"MD",X=3:"PD",X=4:"ANA",X=5:"T-CELL",X=6:"B-CELL",X=7:"NULL-CELL",1:"")
+5 QUIT X
+6 ;
EX ;EXIT
+1 KILL SS
QUIT
