ONCOCRC ;HINES OIFO/GWB - Miscellaneous ;06/23/10
;;2.2;ONCOLOGY;**1,13**;Jul 31, 2013;Build 7
;
SAG ;CLASS OF CASE (165.5,.04) AG1 CROSS-REFERENCE SET STATEMENT
;CLASS CATEGORY (165.5,.042)
N CC
S CC=$S(X="":"",X>9:0,1:1)
I CC'="" D
.S $P(^ONCO(165.5,DA,0),U,20)=CC
.S ^ONCO(165.5,"AG",CC,DA)=""
Q
;
KAG ;CLASS OF CASE (165.5,.04) AG1 CROSS-REFERENCE KILL STATEMENT
N XCC
S XCC=$P(^ONCO(165.5,DA,0),U,20) Q:XCC=""
S $P(^ONCO(165.5,DA,0),U,20)=""
K ^ONCO(165.5,"AG",XCC,DA)
Q
;
SACL ;Reset next accession number
Q:'$D(ONCOACL) S XY=$E(X,1,2),XAC=$E(X,3,6) K ^ONCO(165.5,"XACD",XY,XAC)
I '$D(^ONCO(165.5,"ACL",XY)) S ^ONCO(165.5,"ACL",XY)=XAC G EX
G EX:'(XAC>^ONCO(165.5,"ACL",XY)) K ^ONCO(165.5,"ACL",XY) S ^ONCO(165.5,"ACL",XY)=XAC G EX
;
KACL ;KILL FOR NEXT Accession Number
Q:'$D(ONCOACL) Q:$D(^ONCO(165.5,"AE",X)) S XY=$E(X,1,2),XAC=$E(X,3,6),XX=$G(^ONCO(165.5,"ACL",XY)) G EX:XX="" I XX>XAC S ^ONCO(165.5,"ACD",XY,XAC)="" G EX
I XAC>^ONCO(165.5,"ACL",XY) W !!,?5,"ERROR in Accession Numbers - call Developer",!! G EX
K ^ONCO(165.5,"ACL",XY) F J=1:1 S XAC=XAC-1 S XX=$E(XAC,3,6) G EX:XX="0000" I $D(^ONCO(165.5,"AE",XAC)) S ^ONCO(165.5,"ACL",XY)=XX G EX
;
Q
PSSG ;SET AJCC SUMMARY STAGE GROUP from PATHOLOGIC STAGE GROUP (#88) FIELD
N SG,XD0,DATEDX
S XD0=DA,DATEDX=$P($G(^ONCO(165.5,DA,0)),U,16)
I DATEDX<3180000 S CSG=$P($G(^ONCO(165.5,DA,2)),U,20),CSGD="" I CSG'="" S CSG=$E(CSG)
I DATEDX>3171231 S CSG=$P($G(^ONCO(165.5,DA,"AJCC8")),U,5),CSGD="" I CSG'="" S CSG=$E(CSG)
I CSG'="" S CSGD=$S(CSG=0:0,CSG=1:"I",CSG=2:"II",CSG=3:"III",CSG=4:"IV",CSG=9:"U",CSG=8:"NA",1:"")
S SG=$E(X),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9&(CSG>7):"U",SG=9&(CSG=""):"U",SG=8&(CSG>7):"NA",SG=8&(CSG=""):"NA",1:CSGD) D KGF,SGF G EX
;
CSSG ;SET AJCC SUMMARY STAGE GROUP from CLINICAL STAGE GROUP (#38) FIELD
N SG,XD0,DATEDX
S XD0=DA,DATEDX=$P($G(^ONCO(165.5,DA,0)),U,16)
I DATEDX<3180000 S PSG=$P($G(^ONCO(165.5,DA,2.1)),U,4),PSGD="" I PSG'="" S PSG=$E(PSG)
I DATEDX>3171231 S PSG=$P($G(^ONCO(165.5,DA,"AJCC8")),U,9),PSGD="" I PSG'="" S PSG=$E(PSG)
I PSG'="" S PSGD=$S(PSG=0:0,PSG=1:"I",PSG=2:"II",PSG=3:"III",PSG=4:"IV",PSG=9:"U",PSG=8:"NA",1:"")
I PSG'="",PSG<7 S SG=PSGD D KGF,SGF G EX
S SG=$E(X),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9&(PSG'=8):"U",SG=8&(PSG'=9):"NA",1:PSGD) D KGF,SGF G EX
;
SSG ;SET AJCC SUMMARY STAGE GROUP from SUMMARY STAGE
N SG,XD0
S XD0=DA,SG=$E(X),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9:"U",SG=8:"NA",1:"") D KGF,SGF G EX
;
KGF ;KILL OLD AJCC-GP X-REFERENCE
N XSG
S XSG=$S($D(^ONCO(165.5,XD0,2)):$P(^(2),U,28),1:"") Q:XSG="" K ^ONCO(165.5,"ASG",XSG,DA) Q
;
SGF ;STUFF #38.5 AJCC SUMMARY STAGE-GROUP (2;28) and SET NEW CROSS REFERENCE
Q:SG="" S $P(^ONCO(165.5,XD0,2),U,28)=SG,^ONCO(165.5,"ASG",SG,DA)="" Q
;
KSG ;KILL STATEMENT F
S XD0=DA D KGF
I $D(DC) I DC="" D
.S SG=$S(DI=38:$P(^ONCO(165.5,XD0,2.1),U,4),DI=88:$P(^ONCO(165.5,XD0,2),U,20),DI=5004:$P(^ONCO(165.5,XD0,"AJCC8"),U,9),DI=5014:$P(^ONCO(165.5,XD0,"AJCC8"),U,5),1:"")
.S SG=$E(SG),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9:"U",SG=8:"NA",1:"")
.S $P(^ONCO(165.5,XD0,2),U,28)=SG S:SG'="" ^ONCO(165.5,"ASG",SG,DA)="" Q
G EX
;
EX ;Exit
K CSG,CSGD,J,ONCOACL,PSG,PSGD,XAC,XY,XD0,XX,XCC,XSG
Q
;
SNHL ;Set SYSTEMIC SYMPTOMS (165.5,843) triggered from LYMPH NODES (165.5,31)
N ONCOS S ONCOS=$P($G(^ONCO(165.5,DA,0)),U,1) ;Site/Gp
N ONCOH S ONCOH=$$HIST^ONCFUNC(DA) ;Histology
;If Lymphoma, set SYSTEMIC SYMPTOMS (165.5,843)
I $$LYMPHOMA^ONCFUNC(DA)!(ONCOS=62)!(ONCOS=63) D Q
.S $P(^ONCO(165.5,DA,"NHL1"),U,44)=$S(X=0:1,X=1!(X=2)!(X=3):2,X=9:9,1:"") Q
Q
KNHL ;
Q
;
CLEANUP ;Cleanup
K DA,DC,DI,X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCRC 3797 printed Apr 09, 2024@21:30:46 Page 2
ONCOCRC ;HINES OIFO/GWB - Miscellaneous ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,13**;Jul 31, 2013;Build 7
+2 ;
SAG ;CLASS OF CASE (165.5,.04) AG1 CROSS-REFERENCE SET STATEMENT
+1 ;CLASS CATEGORY (165.5,.042)
+2 NEW CC
+3 SET CC=$SELECT(X="":"",X>9:0,1:1)
+4 IF CC'=""
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,0),U,20)=CC
+6 SET ^ONCO(165.5,"AG",CC,DA)=""
End DoDot:1
+7 QUIT
+8 ;
KAG ;CLASS OF CASE (165.5,.04) AG1 CROSS-REFERENCE KILL STATEMENT
+1 NEW XCC
+2 SET XCC=$PIECE(^ONCO(165.5,DA,0),U,20)
if XCC=""
QUIT
+3 SET $PIECE(^ONCO(165.5,DA,0),U,20)=""
+4 KILL ^ONCO(165.5,"AG",XCC,DA)
+5 QUIT
+6 ;
SACL ;Reset next accession number
+1 if '$DATA(ONCOACL)
QUIT
SET XY=$EXTRACT(X,1,2)
SET XAC=$EXTRACT(X,3,6)
KILL ^ONCO(165.5,"XACD",XY,XAC)
+2 IF '$DATA(^ONCO(165.5,"ACL",XY))
SET ^ONCO(165.5,"ACL",XY)=XAC
GOTO EX
+3 if '(XAC>^ONCO(165.5,"ACL",XY))
GOTO EX
KILL ^ONCO(165.5,"ACL",XY)
SET ^ONCO(165.5,"ACL",XY)=XAC
GOTO EX
+4 ;
KACL ;KILL FOR NEXT Accession Number
+1 if '$DATA(ONCOACL)
QUIT
if $DATA(^ONCO(165.5,"AE",X))
QUIT
SET XY=$EXTRACT(X,1,2)
SET XAC=$EXTRACT(X,3,6)
SET XX=$GET(^ONCO(165.5,"ACL",XY))
if XX=""
GOTO EX
IF XX>XAC
SET ^ONCO(165.5,"ACD",XY,XAC)=""
GOTO EX
+2 IF XAC>^ONCO(165.5,"ACL",XY)
WRITE !!,?5,"ERROR in Accession Numbers - call Developer",!!
GOTO EX
+3 KILL ^ONCO(165.5,"ACL",XY)
FOR J=1:1
SET XAC=XAC-1
SET XX=$EXTRACT(XAC,3,6)
if XX="0000"
GOTO EX
IF $DATA(^ONCO(165.5,"AE",XAC))
SET ^ONCO(165.5,"ACL",XY)=XX
GOTO EX
+4 ;
+5 QUIT
PSSG ;SET AJCC SUMMARY STAGE GROUP from PATHOLOGIC STAGE GROUP (#88) FIELD
+1 NEW SG,XD0,DATEDX
+2 SET XD0=DA
SET DATEDX=$PIECE($GET(^ONCO(165.5,DA,0)),U,16)
+3 IF DATEDX<3180000
SET CSG=$PIECE($GET(^ONCO(165.5,DA,2)),U,20)
SET CSGD=""
IF CSG'=""
SET CSG=$EXTRACT(CSG)
+4 IF DATEDX>3171231
SET CSG=$PIECE($GET(^ONCO(165.5,DA,"AJCC8")),U,5)
SET CSGD=""
IF CSG'=""
SET CSG=$EXTRACT(CSG)
+5 IF CSG'=""
SET CSGD=$SELECT(CSG=0:0,CSG=1:"I",CSG=2:"II",CSG=3:"III",CSG=4:"IV",CSG=9:"U",CSG=8:"NA",1:"")
+6 SET SG=$EXTRACT(X)
SET SG=$SELECT(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9&(CSG>7):"U",SG=9&(CSG=""):"U",SG=8&(CSG>7):"NA",SG=8&(CSG=""):"NA",1:CSGD)
DO KGF
DO SGF
GOTO EX
+7 ;
CSSG ;SET AJCC SUMMARY STAGE GROUP from CLINICAL STAGE GROUP (#38) FIELD
+1 NEW SG,XD0,DATEDX
+2 SET XD0=DA
SET DATEDX=$PIECE($GET(^ONCO(165.5,DA,0)),U,16)
+3 IF DATEDX<3180000
SET PSG=$PIECE($GET(^ONCO(165.5,DA,2.1)),U,4)
SET PSGD=""
IF PSG'=""
SET PSG=$EXTRACT(PSG)
+4 IF DATEDX>3171231
SET PSG=$PIECE($GET(^ONCO(165.5,DA,"AJCC8")),U,9)
SET PSGD=""
IF PSG'=""
SET PSG=$EXTRACT(PSG)
+5 IF PSG'=""
SET PSGD=$SELECT(PSG=0:0,PSG=1:"I",PSG=2:"II",PSG=3:"III",PSG=4:"IV",PSG=9:"U",PSG=8:"NA",1:"")
+6 IF PSG'=""
IF PSG<7
SET SG=PSGD
DO KGF
DO SGF
GOTO EX
+7 SET SG=$EXTRACT(X)
SET SG=$SELECT(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9&(PSG'=8):"U",SG=8&(PSG'=9):"NA",1:PSGD)
DO KGF
DO SGF
GOTO EX
+8 ;
SSG ;SET AJCC SUMMARY STAGE GROUP from SUMMARY STAGE
+1 NEW SG,XD0
+2 SET XD0=DA
SET SG=$EXTRACT(X)
SET SG=$SELECT(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9:"U",SG=8:"NA",1:"")
DO KGF
DO SGF
GOTO EX
+3 ;
KGF ;KILL OLD AJCC-GP X-REFERENCE
+1 NEW XSG
+2 SET XSG=$SELECT($DATA(^ONCO(165.5,XD0,2)):$PIECE(^(2),U,28),1:"")
if XSG=""
QUIT
KILL ^ONCO(165.5,"ASG",XSG,DA)
QUIT
+3 ;
SGF ;STUFF #38.5 AJCC SUMMARY STAGE-GROUP (2;28) and SET NEW CROSS REFERENCE
+1 if SG=""
QUIT
SET $PIECE(^ONCO(165.5,XD0,2),U,28)=SG
SET ^ONCO(165.5,"ASG",SG,DA)=""
QUIT
+2 ;
KSG ;KILL STATEMENT F
+1 SET XD0=DA
DO KGF
+2 IF $DATA(DC)
IF DC=""
Begin DoDot:1
+3 SET SG=$SELECT(DI=38:$PIECE(^ONCO(165.5,XD0,2.1),U,4),DI=88:$PIECE(^ONCO(165.5,XD0,2),U,20),DI=5004:$PIECE(^ONCO(165.5,XD0,"AJCC8"),U,9),DI=5014:$PIECE(^ONCO(165.5,XD0,"AJCC8"),U,5),1:"")
+4 SET SG=$EXTRACT(SG)
SET SG=$SELECT(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9:"U",SG=8:"NA",1:"")
+5 SET $PIECE(^ONCO(165.5,XD0,2),U,28)=SG
if SG'=""
SET ^ONCO(165.5,"ASG",SG,DA)=""
QUIT
End DoDot:1
+6 GOTO EX
+7 ;
EX ;Exit
+1 KILL CSG,CSGD,J,ONCOACL,PSG,PSGD,XAC,XY,XD0,XX,XCC,XSG
+2 QUIT
+3 ;
SNHL ;Set SYSTEMIC SYMPTOMS (165.5,843) triggered from LYMPH NODES (165.5,31)
+1 ;Site/Gp
NEW ONCOS
SET ONCOS=$PIECE($GET(^ONCO(165.5,DA,0)),U,1)
+2 ;Histology
NEW ONCOH
SET ONCOH=$$HIST^ONCFUNC(DA)
+3 ;If Lymphoma, set SYSTEMIC SYMPTOMS (165.5,843)
+4 IF $$LYMPHOMA^ONCFUNC(DA)!(ONCOS=62)!(ONCOS=63)
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,"NHL1"),U,44)=$SELECT(X=0:1,X=1!(X=2)!(X=3):2,X=9:9,1:"")
QUIT
End DoDot:1
QUIT
+6 QUIT
KNHL ;
+1 QUIT
+2 ;
CLEANUP ;Cleanup
+1 KILL DA,DC,DI,X
