ONC2PS17 ;HINES OIFO/RTK - Post-Install Routine for Patch ONC*2.2*17 ;02/14/23
;;2.2;ONCOLOGY;**17**;Jul 31, 2013;Build 6
;
D CONV3884
D REMV3884
D SETTUSS
D SGAJ385
N RC
;DC production server Patch 17
S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:83/cgi_bin/oncsrv.exe")
;DC PRODUCTION SERVER V21
;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:86/cgi_bin/oncsrv.exe")
;test server uRL V21
;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:81/cgi_bin/oncsrv.exe")
Q
;
CONV3884 ;Convert value of field 3884 to 3 new fields 3957,3958,3959
;Originally planned for p15 moved to p17
D MES^XPDUTL("Convert value of field #3884 in file #165.5...")
N ONC38COD,ONC3800,ONC3884,ONC3957,ONC3958,ONC3959
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
..S ONC3884=$P($G(^ONCO(165.5,IEN,"SSD3")),"^",14) I ONC3884="" Q
..S ONC3800=$P($G(^ONCO(165.5,IEN,"SSD1")),"^",1) I ONC3800="" Q
..S ONC38COD=ONC3884-1 I (ONC38COD'>0)&(ONC38COD'<10) Q
..I (ONC38COD=0)!(ONC38COD=8)!(ONC38COD=9) D Q
...I (ONC3800="09520")!(ONC3800="00520") D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",10)=ONC38COD
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",11)=ONC38COD
...I ONC3800="00510" D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",10)=ONC38COD
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",11)=ONC38COD
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",12)=ONC38COD
...I ONC3800="00500" D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",10)=ONC38COD
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",12)=ONC38COD
..I (ONC3800="00500")!(ONC3800="00510") D Q
...I (ONC38COD=1)!(ONC38COD=4)!(ONC38COD=5)!(ONC38COD=7) D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",12)=1
...I (ONC38COD=2)!(ONC38COD=3)!(ONC38COD=6) D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",12)=0
..I (ONC3800="00510")!(ONC3800="00520")!(ONC3800="09520") D Q
...I (ONC38COD=2)!(ONC38COD=4)!(ONC38COD=6)!(ONC38COD=7) D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",11)=1
...I (ONC38COD=1)!(ONC38COD=3)!(ONC38COD=5) D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",11)=0
..I (ONC3800="00500")!(ONC3800="00510")!(ONC3800="00520")!(ONC3800="09520") D Q
...I (ONC38COD=3)!(ONC38COD=5)!(ONC38COD=6)!(ONC38COD=7) D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",10)=1
...I (ONC38COD=1)!(ONC38COD=2)!(ONC38COD=4) D Q
....S $P(^ONCO(165.5,IEN,"SSD5"),"^",10)=0
K ONC38COD,ONC3800,ONC3884,ONC3957,ONC3958,ONC3959
Q
;
REMV3884 ;Remove data in fields 3884, 3871 and 3872
N ONCDXVP
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
..I $P($G(^ONCO(165.5,IEN,"SSD3")),"^",14)'="" S $P(^ONCO(165.5,IEN,"SSD3"),"^",14)=""
..I $P($G(^ONCO(165.5,IEN,"SSD3")),"^",1)'="" S $P(^ONCO(165.5,IEN,"SSD3"),"^",1)=""
..I $P($G(^ONCO(165.5,IEN,"SSD3")),"^",2)'="" S $P(^ONCO(165.5,IEN,"SSD3"),"^",2)=""
K ONCDXVP
Q
;
SETTUSS ;Fill value of new Tobacco Usage Smoking Status (#165.5,#288) field
D BMES^XPDUTL("Set value of field #288 in file #165.5...")
N ONCDXVP,ONCPTIEN,IEN,MULT
S ONCDXVP=3211231 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 ONCPTIEN=$P($G(^ONCO(165.5,IEN,0)),"^",2)
..S ONCPTBHI=$P($G(^ONCO(160,ONCPTIEN,8)),"^",2)
..S ONCPTBUC=$P($G(^ONCO(160,ONCPTIEN,8)),"^",9)
..S ONCPTBOS=$P($G(^ONCO(160,ONCPTIEN,8)),"^",10)
..I $P($G(^ONCO(165.5,IEN,7)),"^",2)'=3 Q
..D CHKOTH I OLDDX=1 Q
..;
..I (ONCPTBHI=0)!(ONCPTBHI=3) S $P(^ONCO(165.5,IEN,25),"^",21)=0
..I (ONCPTBHI=1)!(ONCPTBHI=2)!(ONCPTBHI=4) S $P(^ONCO(165.5,IEN,25),"^",21)=1
..I ONCPTBHI=9 S $P(^ONCO(165.5,IEN,25),"^",21)=9
..I (ONCPTBHI=5)&((ONCPTBUC=2)!(ONCPTBOS=2)) S $P(^ONCO(165.5,IEN,25),"^",21)=3
..I (ONCPTBHI=5)&((ONCPTBUC=3)!(ONCPTBOS=3)) S $P(^ONCO(165.5,IEN,25),"^",21)=2
..I (ONCPTBHI=5)&((ONCPTBUC=4)!(ONCPTBOS=4)) S $P(^ONCO(165.5,IEN,25),"^",21)=2
Q
;
CHKOTH ;Check if patient has other primaries, if any with Date DX < 2022 skip
S OLDDX=0
S MULT=0 F S MULT=$O(^ONCO(165.5,"C",ONCPTIEN,MULT)) Q:MULT'>0 D
.I $P($G(^ONCO(165.5,MULT,0)),"^",16)<3220000 S OLDDX=1 Q
K MULT
Q
;
SGAJ385 ;Execute trigger on STAGE GROUP (#38.5) for 2018+ cases
D MES^XPDUTL("Checking STAGE GROUP (#38.5) field...")
S ONCDXVP=3171231 F S ONCDXVP=$O(^ONCO(165.5,"ADX",ONCDXVP)) Q:ONCDXVP'>0 D
.S ONCIEN=0 F S ONCIEN=$O(^ONCO(165.5,"ADX",ONCDXVP,ONCIEN)) Q:ONCIEN'>0 D
..;S STGRP=$P($G(^ONCO(165.5,ONCIEN,2)),"^",28) I STGRP'="" Q
..S CSTG=$P($G(^ONCO(165.5,ONCIEN,"AJCC8")),"^",5)
..S PSTG=$P($G(^ONCO(165.5,ONCIEN,"AJCC8")),"^",9)
..I CSTG="",PSTG="" Q
..I CSTG'="" S TMP=$G(DA) S DA=ONCIEN,X=CSTG D CSSG^ONCOCRC S DA=TMP Q
..I PSTG'="" S TMP=$G(DA) S DA=ONCIEN,X=PSTG D PSSG^ONCOCRC S DA=TMP Q
..Q
.Q
K ONCDXVP,ONCIEN,STGRP,CSTG,PSTG,TMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONC2PS17 4898 printed Sep 23, 2025@19:57:59 Page 2
ONC2PS17 ;HINES OIFO/RTK - Post-Install Routine for Patch ONC*2.2*17 ;02/14/23
+1 ;;2.2;ONCOLOGY;**17**;Jul 31, 2013;Build 6
+2 ;
+3 DO CONV3884
+4 DO REMV3884
+5 DO SETTUSS
+6 DO SGAJ385
+7 NEW RC
+8 ;DC production server Patch 17
+9 SET RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:83/cgi_bin/oncsrv.exe")
+10 ;DC PRODUCTION SERVER V21
+11 ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:86/cgi_bin/oncsrv.exe")
+12 ;test server uRL V21
+13 ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:81/cgi_bin/oncsrv.exe")
+14 QUIT
+15 ;
CONV3884 ;Convert value of field 3884 to 3 new fields 3957,3958,3959
+1 ;Originally planned for p15 moved to p17
+2 DO MES^XPDUTL("Convert value of field #3884 in file #165.5...")
+3 NEW ONC38COD,ONC3800,ONC3884,ONC3957,ONC3958,ONC3959
+4 SET ONCDXVP=3171231
FOR
SET ONCDXVP=$ORDER(^ONCO(165.5,"ADX",ONCDXVP))
if ONCDXVP'>0
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXVP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+6 SET ONC3884=$PIECE($GET(^ONCO(165.5,IEN,"SSD3")),"^",14)
IF ONC3884=""
QUIT
+7 SET ONC3800=$PIECE($GET(^ONCO(165.5,IEN,"SSD1")),"^",1)
IF ONC3800=""
QUIT
+8 SET ONC38COD=ONC3884-1
IF (ONC38COD'>0)&(ONC38COD'<10)
QUIT
+9 IF (ONC38COD=0)!(ONC38COD=8)!(ONC38COD=9)
Begin DoDot:3
+10 IF (ONC3800="09520")!(ONC3800="00520")
Begin DoDot:4
+11 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",10)=ONC38COD
+12 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",11)=ONC38COD
End DoDot:4
QUIT
+13 IF ONC3800="00510"
Begin DoDot:4
+14 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",10)=ONC38COD
+15 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",11)=ONC38COD
+16 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",12)=ONC38COD
End DoDot:4
QUIT
+17 IF ONC3800="00500"
Begin DoDot:4
+18 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",10)=ONC38COD
+19 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",12)=ONC38COD
End DoDot:4
QUIT
End DoDot:3
QUIT
+20 IF (ONC3800="00500")!(ONC3800="00510")
Begin DoDot:3
+21 IF (ONC38COD=1)!(ONC38COD=4)!(ONC38COD=5)!(ONC38COD=7)
Begin DoDot:4
+22 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",12)=1
End DoDot:4
QUIT
+23 IF (ONC38COD=2)!(ONC38COD=3)!(ONC38COD=6)
Begin DoDot:4
+24 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",12)=0
End DoDot:4
QUIT
End DoDot:3
QUIT
+25 IF (ONC3800="00510")!(ONC3800="00520")!(ONC3800="09520")
Begin DoDot:3
+26 IF (ONC38COD=2)!(ONC38COD=4)!(ONC38COD=6)!(ONC38COD=7)
Begin DoDot:4
+27 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",11)=1
End DoDot:4
QUIT
+28 IF (ONC38COD=1)!(ONC38COD=3)!(ONC38COD=5)
Begin DoDot:4
+29 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",11)=0
End DoDot:4
QUIT
End DoDot:3
QUIT
+30 IF (ONC3800="00500")!(ONC3800="00510")!(ONC3800="00520")!(ONC3800="09520")
Begin DoDot:3
+31 IF (ONC38COD=3)!(ONC38COD=5)!(ONC38COD=6)!(ONC38COD=7)
Begin DoDot:4
+32 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",10)=1
End DoDot:4
QUIT
+33 IF (ONC38COD=1)!(ONC38COD=2)!(ONC38COD=4)
Begin DoDot:4
+34 SET $PIECE(^ONCO(165.5,IEN,"SSD5"),"^",10)=0
End DoDot:4
QUIT
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+35 KILL ONC38COD,ONC3800,ONC3884,ONC3957,ONC3958,ONC3959
+36 QUIT
+37 ;
REMV3884 ;Remove data in fields 3884, 3871 and 3872
+1 NEW ONCDXVP
+2 SET ONCDXVP=3171231
FOR
SET ONCDXVP=$ORDER(^ONCO(165.5,"ADX",ONCDXVP))
if ONCDXVP'>0
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXVP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+4 IF $PIECE($GET(^ONCO(165.5,IEN,"SSD3")),"^",14)'=""
SET $PIECE(^ONCO(165.5,IEN,"SSD3"),"^",14)=""
+5 IF $PIECE($GET(^ONCO(165.5,IEN,"SSD3")),"^",1)'=""
SET $PIECE(^ONCO(165.5,IEN,"SSD3"),"^",1)=""
+6 IF $PIECE($GET(^ONCO(165.5,IEN,"SSD3")),"^",2)'=""
SET $PIECE(^ONCO(165.5,IEN,"SSD3"),"^",2)=""
End DoDot:2
End DoDot:1
+7 KILL ONCDXVP
+8 QUIT
+9 ;
SETTUSS ;Fill value of new Tobacco Usage Smoking Status (#165.5,#288) field
+1 DO BMES^XPDUTL("Set value of field #288 in file #165.5...")
+2 NEW ONCDXVP,ONCPTIEN,IEN,MULT
+3 SET ONCDXVP=3211231
FOR
SET ONCDXVP=$ORDER(^ONCO(165.5,"ADX",ONCDXVP))
if ONCDXVP'>0
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXVP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+5 SET ONCPTIEN=$PIECE($GET(^ONCO(165.5,IEN,0)),"^",2)
+6 SET ONCPTBHI=$PIECE($GET(^ONCO(160,ONCPTIEN,8)),"^",2)
+7 SET ONCPTBUC=$PIECE($GET(^ONCO(160,ONCPTIEN,8)),"^",9)
+8 SET ONCPTBOS=$PIECE($GET(^ONCO(160,ONCPTIEN,8)),"^",10)
+9 IF $PIECE($GET(^ONCO(165.5,IEN,7)),"^",2)'=3
QUIT
+10 DO CHKOTH
IF OLDDX=1
QUIT
+11 ;
+12 IF (ONCPTBHI=0)!(ONCPTBHI=3)
SET $PIECE(^ONCO(165.5,IEN,25),"^",21)=0
+13 IF (ONCPTBHI=1)!(ONCPTBHI=2)!(ONCPTBHI=4)
SET $PIECE(^ONCO(165.5,IEN,25),"^",21)=1
+14 IF ONCPTBHI=9
SET $PIECE(^ONCO(165.5,IEN,25),"^",21)=9
+15 IF (ONCPTBHI=5)&((ONCPTBUC=2)!(ONCPTBOS=2))
SET $PIECE(^ONCO(165.5,IEN,25),"^",21)=3
+16 IF (ONCPTBHI=5)&((ONCPTBUC=3)!(ONCPTBOS=3))
SET $PIECE(^ONCO(165.5,IEN,25),"^",21)=2
+17 IF (ONCPTBHI=5)&((ONCPTBUC=4)!(ONCPTBOS=4))
SET $PIECE(^ONCO(165.5,IEN,25),"^",21)=2
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
CHKOTH ;Check if patient has other primaries, if any with Date DX < 2022 skip
+1 SET OLDDX=0
+2 SET MULT=0
FOR
SET MULT=$ORDER(^ONCO(165.5,"C",ONCPTIEN,MULT))
if MULT'>0
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^ONCO(165.5,MULT,0)),"^",16)<3220000
SET OLDDX=1
QUIT
End DoDot:1
+4 KILL MULT
+5 QUIT
+6 ;
SGAJ385 ;Execute trigger on STAGE GROUP (#38.5) for 2018+ cases
+1 DO MES^XPDUTL("Checking STAGE GROUP (#38.5) field...")
+2 SET ONCDXVP=3171231
FOR
SET ONCDXVP=$ORDER(^ONCO(165.5,"ADX",ONCDXVP))
if ONCDXVP'>0
QUIT
Begin DoDot:1
+3 SET ONCIEN=0
FOR
SET ONCIEN=$ORDER(^ONCO(165.5,"ADX",ONCDXVP,ONCIEN))
if ONCIEN'>0
QUIT
Begin DoDot:2
+4 ;S STGRP=$P($G(^ONCO(165.5,ONCIEN,2)),"^",28) I STGRP'="" Q
+5 SET CSTG=$PIECE($GET(^ONCO(165.5,ONCIEN,"AJCC8")),"^",5)
+6 SET PSTG=$PIECE($GET(^ONCO(165.5,ONCIEN,"AJCC8")),"^",9)
+7 IF CSTG=""
IF PSTG=""
QUIT
+8 IF CSTG'=""
SET TMP=$GET(DA)
SET DA=ONCIEN
SET X=CSTG
DO CSSG^ONCOCRC
SET DA=TMP
QUIT
+9 IF PSTG'=""
SET TMP=$GET(DA)
SET DA=ONCIEN
SET X=PSTG
DO PSSG^ONCOCRC
SET DA=TMP
QUIT
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 KILL ONCDXVP,ONCIEN,STGRP,CSTG,PSTG,TMP
+13 QUIT
