ONC2PS21 ;HINES OIFO/RTK - Post-Install Routine for Patch ONC*2.2*21 ;11/05/24
;;2.2;ONCOLOGY;**21**;Jul 31, 2013;Build 6
;
N ONCVER S ONCVER=$$PATCH^XPDUTL("ONC*2.2*21") I ONCVER=1 Q
D XTMP ;initialize XTMP zero node
D CNV3700
D CNV5000
D CNVTORS
Q
;
CNV3700 ;Convert any cases with SEER Site Specific Fact 1 (Field #3700)
;HPV Status field changed from Set of Codes to Pointer to File #167.7
;
D BMES^XPDUTL("Convert cases with SEER Site Specific Fact 1 HPV Status...")
I $E($P(^XTMP("ONC*2.2*21",0),U,4),1)="C" D Q
.D BMES^XPDUTL("SEER Conversion completed.")
N IEN,ONCDXVP,ONC3700,ONC3800,ONC3927
S ONCDXVP=3171231 F S ONCDXVP=$O(^ONCO(165.5,"ADX",ONCDXVP)) Q:ONCDXVP'>0 D
.S IEN=0 F S IEN=$O(^ONCO(165.5,"ADX",ONCDXVP,IEN)) Q:IEN'>0 D
..Q:$D(^XTMP("ONC*2.2*21",4,IEN)) ;already converted
..S ONC3700=$P($G(^ONCO(165.5,IEN,"SSD4")),"^",33) I ONC3700="" Q
..S ONC3800=$P($G(^ONCO(165.5,IEN,"SSD1")),"^",1)
..S ONC3927=$P($G(^ONCO(165.5,IEN,"SSD4")),"^",22)
..I ONC3700=0 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=3 ;new code 20
..I ONC3700=1 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=4 ;new code 21
..I ONC3700=2 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=5 ;new code 30
..I ONC3700=3 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=6 ;new code 31
..I ONC3700=4 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=7 ;new code 40
..I ONC3700=5 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=8 ;new code 41
..I ONC3700=6 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=9 ;new code 50
..I ONC3700=7 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=10 ;new code 51
..I "00071^00072^00073^00074^00075^00076^00077^00112"[ONC3800 D
...I ONC3700=8 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=13 ;new code 97
...I ONC3700=9 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=14 ;new code 99
..I ONC3800="00100" D
...I ONC3700=8 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=2 ;new code 11
...I ONC3700=9 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=2 ;new code 11
..I ONC3800="00111",ONC3927=1 D
...I ONC3700=8 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=1 ;new code 10
...I ONC3700=9 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=1 ;new code 10
..I ONC3800="00111",ONC3927=9 D
...I ONC3700=8 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=13 ;new code 97
...I ONC3700=9 S $P(^ONCO(165.5,IEN,"SSD4"),"^",33)=14 ;new code 99
..S ^XTMP("ONC*2.2*21",4,IEN)=""
..Q
.Q
S $P(^XTMP("ONC*2.2*21",0),U,4)="Completed"
D BMES^XPDUTL("Conversion completed...")
Q
;
CNV5000 ;Convert AJCC ID for 9th Edition cases (Field #5000)
; New 9th Edition using 4 digit AJCC ID (9000-9999 range)
;
D BMES^XPDUTL("Convert AJCC ID for v9 protocols...")
N IEN,ONCDXVP,ONC3800,ONC5000
S ONCDXVP=3201231 F S ONCDXVP=$O(^ONCO(165.5,"ADX",ONCDXVP)) Q:ONCDXVP'>0 D
.S IEN=0 F S IEN=$O(^ONCO(165.5,"ADX",ONCDXVP,IEN)) Q:IEN'>0 D
..S ONC5000=$P($G(^ONCO(165.5,IEN,"AJCC8")),"^",1) I ONC5000="" Q
..S ONC3800=$P($G(^ONCO(165.5,IEN,"SSD1")),U,1) I ONC3800="" Q
..I ONC5000=52,ONC3800="09520" D
...S $P(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9001 ;Cervix/9001
..I ONC5000=19,ONC3800="09190" D
...S $P(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9002 ;Appendix/9002
..I ONC5000=21,ONC3800="09210" D
...S $P(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9003 ;Anus/9003
..I ((ONC5000=72)!(ONC5000="72.1"))&("09721^09722^09723^09724"[ONC3800) D
...I ONCDXVP<3230000 Q
...S $P(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9004 ;Brain & SC Other/9004
..I ONC5000="72.2",ONC3800="09724" D
...I ONCDXVP<3230000 Q
...S $P(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9005 ;Brain & SC Medulloblastoma/9005
..Q
.Q
Q
;
CNVTORS ;Convert Type of Reporting Source (field #1.2) for ALL cases to 1
S ONCDXVP=2791231 F S ONCDXVP=$O(^ONCO(165.5,"ADX",ONCDXVP)) Q:ONCDXVP'>0 D
.S IEN=0 F S IEN=$O(^ONCO(165.5,"ADX",ONCDXVP,IEN)) Q:IEN'>0 D
..S $P(^ONCO(165.5,IEN,0),"^",10)=1
Q
;
XTMP ;initialize XTMP zero node
;format: ^XTMP(namespace,0)=purge date(FM)^create date(FM)^description(optional)
N ONCPURGEDT
S ONCPURGEDT=$$FMADD^XLFDT(DT,90) ;purge date = DT + 90 days
S ^XTMP("ONC*2.2*21",0)=ONCPURGEDT_U_DT_U_"data conversion"
;4th piece of zero node is set to "Completed" when CNV3700 conversion is finished.
;set ^XTMP("ONC*2.2*21",4,IEN)="" when each CNV3700 entry is converted.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONC2PS21 4244 printed Jan 29, 2026@15:20:33 Page 2
ONC2PS21 ;HINES OIFO/RTK - Post-Install Routine for Patch ONC*2.2*21 ;11/05/24
+1 ;;2.2;ONCOLOGY;**21**;Jul 31, 2013;Build 6
+2 ;
+3 NEW ONCVER
SET ONCVER=$$PATCH^XPDUTL("ONC*2.2*21")
IF ONCVER=1
QUIT
+4 ;initialize XTMP zero node
DO XTMP
+5 DO CNV3700
+6 DO CNV5000
+7 DO CNVTORS
+8 QUIT
+9 ;
CNV3700 ;Convert any cases with SEER Site Specific Fact 1 (Field #3700)
+1 ;HPV Status field changed from Set of Codes to Pointer to File #167.7
+2 ;
+3 DO BMES^XPDUTL("Convert cases with SEER Site Specific Fact 1 HPV Status...")
+4 IF $EXTRACT($PIECE(^XTMP("ONC*2.2*21",0),U,4),1)="C"
Begin DoDot:1
+5 DO BMES^XPDUTL("SEER Conversion completed.")
End DoDot:1
QUIT
+6 NEW IEN,ONCDXVP,ONC3700,ONC3800,ONC3927
+7 SET ONCDXVP=3171231
FOR
SET ONCDXVP=$ORDER(^ONCO(165.5,"ADX",ONCDXVP))
if ONCDXVP'>0
QUIT
Begin DoDot:1
+8 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXVP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+9 ;already converted
if $DATA(^XTMP("ONC*2.2*21",4,IEN))
QUIT
+10 SET ONC3700=$PIECE($GET(^ONCO(165.5,IEN,"SSD4")),"^",33)
IF ONC3700=""
QUIT
+11 SET ONC3800=$PIECE($GET(^ONCO(165.5,IEN,"SSD1")),"^",1)
+12 SET ONC3927=$PIECE($GET(^ONCO(165.5,IEN,"SSD4")),"^",22)
+13 ;new code 20
IF ONC3700=0
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=3
+14 ;new code 21
IF ONC3700=1
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=4
+15 ;new code 30
IF ONC3700=2
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=5
+16 ;new code 31
IF ONC3700=3
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=6
+17 ;new code 40
IF ONC3700=4
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=7
+18 ;new code 41
IF ONC3700=5
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=8
+19 ;new code 50
IF ONC3700=6
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=9
+20 ;new code 51
IF ONC3700=7
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=10
+21 IF "00071^00072^00073^00074^00075^00076^00077^00112"[ONC3800
Begin DoDot:3
+22 ;new code 97
IF ONC3700=8
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=13
+23 ;new code 99
IF ONC3700=9
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=14
End DoDot:3
+24 IF ONC3800="00100"
Begin DoDot:3
+25 ;new code 11
IF ONC3700=8
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=2
+26 ;new code 11
IF ONC3700=9
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=2
End DoDot:3
+27 IF ONC3800="00111"
IF ONC3927=1
Begin DoDot:3
+28 ;new code 10
IF ONC3700=8
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=1
+29 ;new code 10
IF ONC3700=9
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=1
End DoDot:3
+30 IF ONC3800="00111"
IF ONC3927=9
Begin DoDot:3
+31 ;new code 97
IF ONC3700=8
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=13
+32 ;new code 99
IF ONC3700=9
SET $PIECE(^ONCO(165.5,IEN,"SSD4"),"^",33)=14
End DoDot:3
+33 SET ^XTMP("ONC*2.2*21",4,IEN)=""
+34 QUIT
End DoDot:2
+35 QUIT
End DoDot:1
+36 SET $PIECE(^XTMP("ONC*2.2*21",0),U,4)="Completed"
+37 DO BMES^XPDUTL("Conversion completed...")
+38 QUIT
+39 ;
CNV5000 ;Convert AJCC ID for 9th Edition cases (Field #5000)
+1 ; New 9th Edition using 4 digit AJCC ID (9000-9999 range)
+2 ;
+3 DO BMES^XPDUTL("Convert AJCC ID for v9 protocols...")
+4 NEW IEN,ONCDXVP,ONC3800,ONC5000
+5 SET ONCDXVP=3201231
FOR
SET ONCDXVP=$ORDER(^ONCO(165.5,"ADX",ONCDXVP))
if ONCDXVP'>0
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXVP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+7 SET ONC5000=$PIECE($GET(^ONCO(165.5,IEN,"AJCC8")),"^",1)
IF ONC5000=""
QUIT
+8 SET ONC3800=$PIECE($GET(^ONCO(165.5,IEN,"SSD1")),U,1)
IF ONC3800=""
QUIT
+9 IF ONC5000=52
IF ONC3800="09520"
Begin DoDot:3
+10 ;Cervix/9001
SET $PIECE(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9001
End DoDot:3
+11 IF ONC5000=19
IF ONC3800="09190"
Begin DoDot:3
+12 ;Appendix/9002
SET $PIECE(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9002
End DoDot:3
+13 IF ONC5000=21
IF ONC3800="09210"
Begin DoDot:3
+14 ;Anus/9003
SET $PIECE(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9003
End DoDot:3
+15 IF ((ONC5000=72)!(ONC5000="72.1"))&("09721^09722^09723^09724"[ONC3800)
Begin DoDot:3
+16 IF ONCDXVP<3230000
QUIT
+17 ;Brain & SC Other/9004
SET $PIECE(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9004
End DoDot:3
+18 IF ONC5000="72.2"
IF ONC3800="09724"
Begin DoDot:3
+19 IF ONCDXVP<3230000
QUIT
+20 ;Brain & SC Medulloblastoma/9005
SET $PIECE(^ONCO(165.5,IEN,"AJCC8"),"^",1)=9005
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
CNVTORS ;Convert Type of Reporting Source (field #1.2) for ALL cases to 1
+1 SET ONCDXVP=2791231
FOR
SET ONCDXVP=$ORDER(^ONCO(165.5,"ADX",ONCDXVP))
if ONCDXVP'>0
QUIT
Begin DoDot:1
+2 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXVP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+3 SET $PIECE(^ONCO(165.5,IEN,0),"^",10)=1
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
XTMP ;initialize XTMP zero node
+1 ;format: ^XTMP(namespace,0)=purge date(FM)^create date(FM)^description(optional)
+2 NEW ONCPURGEDT
+3 ;purge date = DT + 90 days
SET ONCPURGEDT=$$FMADD^XLFDT(DT,90)
+4 SET ^XTMP("ONC*2.2*21",0)=ONCPURGEDT_U_DT_U_"data conversion"
+5 ;4th piece of zero node is set to "Completed" when CNV3700 conversion is finished.
+6 ;set ^XTMP("ONC*2.2*21",4,IEN)="" when each CNV3700 entry is converted.
+7 QUIT
