ONC2PS10 ;Hines OIFO/RTK - Post-Install Routine for Patch ONC*2.2*10 ;11/27/18
;;2.2;ONCOLOGY;**10**;Jul 31, 2013;Build 20
;
;N RC
;DC production server Patch 10
S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:86/cgi_bin/oncsrv.exe")
;DC test server, comment out for final release.
;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:81/cgi_bin/oncsrv.exe")
;
K ^DD(164.81,.001)
K ^DD(164.82,.001)
K ^DD(164.83,.001)
K ^DD(164.84,.001)
K ^DD(167.1,.001)
K ^DD(167.5,.001)
D LVI,COC,RAD18
Q
PRE ;Pre-init logic
;delete the old version of Extract file
K ^ONCO(160.16)
D BMES^XPDUTL("Done removing old entries in file #160.16")
K ^ONCO(164.44)
K ^ONCO(165.9)
Q
;
LVI ;need to reset any Lymph-Vascular Invasion with value of '1' for
; 2018+ cases, because new 2018 LVI has new values and '1' values
; could be 1 or new 2,3 or 4 values so must be reset
S ONCDXLVI=3171231 F S ONCDXLVI=$O(^ONCO(165.5,"ADX",ONCDXLVI)) Q:ONCDXLVI'>0 D
.S IEN=0 F S IEN=$O(^ONCO(165.5,"ADX",ONCDXLVI,IEN)) Q:IEN'>0 D
..I $P($G(^ONCO(165.5,IEN,2)),"^",19)=1 S $P(^ONCO(165.5,IEN,2),"^",19)=""
K ONCDXLVI Q
COC ;Set the COC Accredited Flag field for 2018+ cases
; code to calculate/automatically set COC ACCREDITED FLAG (#7033) field
; this code will also automatically set the DERIVED SS2018 (#7012) fld
S ONCDXCOC=3171231 F S ONCDXCOC=$O(^ONCO(165.5,"ADX",ONCDXCOC)) Q:ONCDXCOC'>0 D
.S IEN=0 F S IEN=$O(^ONCO(165.5,"ADX",ONCDXCOC,IEN)) Q:IEN'>0 D
..S $P(^ONCO(165.5,IEN,"NCR18"),"^",13)=9 ;set=9 until were able to calc
..I $P($G(^ONCO(165.5,IEN,0)),U,16)<3180000 Q
..I $$COCACC^ONCACDU2'="01" S $P(^ONCO(165.5,IEN,"NCR18B"),"^",10)=0
..I $$COCACC^ONCACDU2="01" D
...N ONCCOC S ONCCOC=$P($G(^ONCO(165.5,IEN,0)),U,4)
...I ((ONCCOC>1)&(ONCCOC<10)) S $P(^ONCO(165.5,IEN,"NCR18B"),"^",10)=1 ;ANALYTIC, class of case 10-22 (iens in 165.3 of 2-9)
...I (ONCCOC=1)!(ONCCOC=24)!((ONCCOC>9)&(ONCCOC<23)) S $P(^ONCO(165.5,IEN,"NCR18B"),"^",10)=2 ;NON-ANALYTIC, class of case 30-43,99,00 (iens 10-22,1,24)
; not set for CoC ien 23
K ONCDXCOC Q
Q
RAD18 ;populate the new 2018 Radiation fields according to the NAACCR
; crosswalk using the existing data in old Radiation fields
;
PASS1 ;
D BMES^XPDUTL("Populate 2018 Radation fields according to NAACCR crosswalk...")
D MES^XPDUTL("...pass 1 (of 5)...")
S ONCDONE=0
S IEN=0 F S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 D
.S DATEDX=$P($G(^ONCO(165.5,IEN,0)),U,16)
.S TOPIEN=$P($G(^ONCO(165.5,IEN,2)),U,1) Q:TOPIEN=""
.S TOPCOD=$P($G(^ONCO(164,TOPIEN,0)),U,2)
.S ONCTPCD=$P(TOPCOD,".",1)_$P(TOPCOD,".",2) ;remove the "."
.S ONCHIST=$$HIST^ONCFUNC(IEN)
.S HST14=$E(ONCHIST,1,4),ONCT3=$E(ONCTPCD,2,5)
.S RAD1540=$P($G(^ONCO(165.5,IEN,3)),U,21)
.S RAD1570=$P($G(^ONCO(165.5,IEN,"BLA2")),U,18)
.S RAD3200=$P($G(^ONCO(165.5,IEN,24)),U,9)
.I RAD1540=1 S RAD1504=1,RAD1505=1,RAD1501="00000" D SETPIECE Q
.I RAD1540=2 S RAD1504=10,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=3 S RAD1504=11,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=4 S RAD1504=12,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=5 S RAD1504=13,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I (RAD1540=6)!(RAD1540=7) D I ONCDONE=1 Q
..I ((HST14>9589)&(HST14<9730)) S RAD1504=2,RAD1505=10,RAD1501="99999" D SETPIECE Q
..I (ONCT3="000")!((ONCT3>0)&(ONCT3<10))!((ONCT3>19)&(ONCT3<51))!((ONCT3>59)&(ONCT3<70)) S RAD1504=16,RAD1505=2,RAD1501="99999" D SETPIECE Q
..I (ONCTPCD="C019")!((ONCT3>50)&(ONCT3<60))!((ONCT3>89)&(ONCT3<110))!(ONCTPCD="C140") S RAD1504=17,RAD1505=2,RAD1501="99999" D SETPIECE Q
..I ((ONCT3>109)&(ONCT3<120)) S RAD1504=15,RAD1505=2,RAD1501="99999" D SETPIECE Q
..I (ONCTPCD="C129")!((ONCT3>129)&(ONCT3<140))!((ONCT3>319)&(ONCT3<330)) S RAD1504=18,RAD1505=2,RAD1501="99999" D SETPIECE Q
..S RAD1504=22,RAD1505=2,RAD1501="99999" D SETPIECE Q
.I RAD1540=8 S RAD1504=18,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=9 S RAD1504=19,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=10 S RAD1504=20,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=11 D I ONCDONE=1 Q
..I ((HST14>9049)&(HST14<9056)) S RAD1504=24,RAD1505=3,RAD1501="99999" D SETPIECE Q
..I ((HST14>8579)&(HST14<8589)) S RAD1504=25,RAD1505=3,RAD1501="99999" D SETPIECE Q
..S RAD1504=26,RAD1505=3,RAD1501="99999" D SETPIECE Q
.I RAD1540=12 D I ONCDONE=1 Q
..I ((HST14>9049)&(HST14<9056)) S RAD1504=24,RAD1505=1,RAD1501="99999" D SETPIECE Q
..I ((HST14>8579)&(HST14<8589)) S RAD1504=25,RAD1505=1,RAD1501="99999" D SETPIECE Q
..S RAD1504=23,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=13 S RAD1504=30,RAD1505=3,RAD1501="99999" D SETPIECE Q
.I RAD1540=14 S RAD1504=31,RAD1505=6,RAD1501="99999" D SETPIECE Q
.I RAD1540=15 S RAD1504=36,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=16 S RAD1504=38,RAD1505=6,RAD1501="99999" D SETPIECE Q
.I RAD1540=17 S RAD1504=42,RAD1505=6,RAD1501="99999" D SETPIECE Q
.I RAD1540=18 D I ONCDONE=1 Q
..I ((ONCT3>169)&(ONCT3<180)) S RAD1504=32,RAD1505=6,RAD1501="99999" D SETPIECE Q
..I ((ONCT3>179)&(ONCT3<190)) S RAD1504=33,RAD1505=11,RAD1501="99999" D SETPIECE Q
..S RAD1504=39,RAD1505=6,RAD1501="99999" D SETPIECE Q
.I RAD1540=19 D I ONCDONE=1 Q
..I ((RAD1570>35)&(RAD1570<42))&(RAD3200=1) S RAD1504=28,RAD1505=1,RAD1501="99999" D SETPIECE Q
..S RAD1504=27,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=20 S RAD1504=27,RAD1505=5,RAD1501="99999" D SETPIECE Q
.I RAD1540=21 S RAD1504=29,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=22 S RAD1504=29,RAD1505=5,RAD1501="99999" D SETPIECE Q
.I RAD1540=23 S RAD1504=65,RAD1505=10,RAD1501="99999" D SETPIECE Q
.I RAD1540=24 S RAD1504=66,RAD1505=10,RAD1501="99999" D SETPIECE Q
.I RAD1540=25 S RAD1504=54,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=26 S RAD1504=53,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=27 S RAD1504=56,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=28 S RAD1504=57,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=29 S RAD1504=58,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=30 D I ONCDONE=1 Q
..I ((HST14>9589)&(HST14<9730)) S RAD1504=7,RAD1505=10,RAD1501="99999" D SETPIECE Q
..I "C180^C181^C182^C183^C184^C185^C186^C187^C188^C189"[ONCTPCD S RAD1504=33,RAD1505=11,RAD1501="99999" D SETPIECE Q
..I ONCTPCD="C209" S RAD1504=34,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I "C210^C211^C212^C213^C214^C215^C216^C217^C218"[ONCTPCD S RAD1504=35,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I "C510^C511^C512^C518"[ONCTPCD S RAD1504=51,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I ONCTPCD="C529" S RAD1504=52,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I ((ONCT3>529)&(ONCT3<560)) S RAD1504=50,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I ONCTPCD="C619" S RAD1504=44,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I ONCTPCD="C669" S RAD1504=43,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I "C670^C671^C672^C673^C674^C675^C676^C677^C678^C679"[ONCTPCD S RAD1504=40,RAD1505=7,RAD1501="99999" D SETPIECE Q
..S RAD1504=59,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=31 S RAD1504=61,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=32 S RAD1504=62,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=33 S RAD1504=63,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=34 S RAD1504=64,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=35 S RAD1504=40,RAD1505=7,RAD1501="99999" D SETPIECE Q
.I RAD1540=36 S RAD1504=44,RAD1505=7,RAD1501="99999" D SETPIECE Q
.I RAD1540=37 S RAD1504=50,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=38 S RAD1504=55,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=39 S RAD1504=60,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=40 S RAD1504=67,RAD1505=10,RAD1501="99999" D SETPIECE Q
.I RAD1540=43 S RAD1504=14,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=44 S RAD1504=44,RAD1505=1,RAD1501="99999" D SETPIECE Q
.I RAD1540=45 S RAD1504=21,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=46 S RAD1504=9,RAD1505=10,RAD1501="99999" D SETPIECE Q
.I RAD1540=41 D I ONCDONE=1 Q
..I ONCTPCD="C669" S RAD1504=43,RAD1505=7,RAD1501="99999" D SETPIECE Q
..I ONCTPCD="C680" S RAD1504=46,RAD1505=11,RAD1501="99999" D SETPIECE Q
..I "C600^C601^C602^C603^C604^C605^C606^C607^C608^C609"[ONCTPCD S RAD1504=47,RAD1505=11,RAD1501="99999" D SETPIECE Q
..I ((ONCT3>619)&(ONCT3<640)) S RAD1504=48,RAD1505=11,RAD1501="99999" D SETPIECE Q
..S RAD1504=69,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540=42 S RAD1504=70,RAD1505=11,RAD1501="99999" D SETPIECE Q
.I RAD1540'="" S RAD1504=68,RAD1505=11,RAD1501="99999" D SETPIECE Q
.Q
;
PASS2 ;
D MES^XPDUTL("...pass 2 (of 5)...")
S IEN=0 F S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 D
.S DATEDX=$P($G(^ONCO(165.5,IEN,0)),U,16)
.S TOPIEN=$P($G(^ONCO(165.5,IEN,2)),U,1) Q:TOPIEN=""
.S TOPCOD=$P($G(^ONCO(164,TOPIEN,0)),U,2)
.S ONCTPCD=$P(TOPCOD,".",1)_$P(TOPCOD,".",2) ;remove the "."
.S ONCHIST=$$HIST^ONCFUNC(IEN)
.S HST14=$E(ONCHIST,1,4),ONCT3=$E(ONCTPCD,2,5)
.S RAD1570=$P($G(^ONCO(165.5,IEN,"BLA2")),U,18)
.I RAD1570="" Q
.I RAD1570=1 S RAD1506=1,RAD1502=1 D SETPASS2 Q
.I (RAD1570=20)!(RAD1570=29) S RAD1506=2,RAD1502=2 D SETPASS2 Q
.I RAD1570=21 S RAD1506=3,RAD1502=3 D SETPASS2 Q
.I (RAD1570=22)!(RAD1570=23)!(RAD1570=24)!(RAD1570=25)!(RAD1570=26)!(RAD1570=27) S RAD1506=3,RAD1502=2 D SETPASS2 Q
.I RAD1570=28 S RAD1506=5,RAD1502=4 D SETPASS2 Q
.I RAD1570=30 S RAD1506=6,RAD1502=2 D SETPASS2 Q
.I RAD1570=31 S RAD1506=3,RAD1502=6 D SETPASS2 Q
.I RAD1570=32 S RAD1506=2,RAD1502=5 D SETPASS2 Q
.I RAD1570=33 S RAD1506=4,RAD1502=2 D SETPASS2 Q
.I RAD1570=34 S RAD1506=3,RAD1502=7 D SETPASS2 Q
.I RAD1570=35 S RAD1506=3,RAD1502=8 D SETPASS2 Q
.I RAD1570=36 S RAD1506=3,RAD1502=9 D SETPASS2 Q
.I RAD1570=37 S RAD1506=8,RAD1502=12 D SETPASS2 Q
.I RAD1570=38 S RAD1506=9,RAD1502=12 D SETPASS2 Q
.I RAD1570=39 S RAD1506=10,RAD1502=12 D SETPASS2 Q
.I RAD1570=40 S RAD1506=11,RAD1502=12 D SETPASS2 Q
.I RAD1570=41 S RAD1506=12,RAD1502=12 D SETPASS2 Q
.I (RAD1570=42)!(RAD1570=43) S RAD1506=14,RAD1502=12 D SETPASS2 Q
.I RAD1570=44 S RAD1506=16,RAD1502=12 D SETPASS2 Q
.I RAD1570=45 S RAD1506=17,RAD1502=12 D SETPASS2 Q
.I (RAD1570=46)!(RAD1570=47)!(RAD1570=18) S RAD1506=18,RAD1502=13 D SETPASS2 Q
.I RAD1570=19 S RAD1506=18,RAD1502=14 D SETPASS2 Q
.I ((RAD1570>1)&(RAD1570<18)) S RAD1506=18,RAD1502=13 D SETPASS2 Q
.Q
;
PASS3 ;
D MES^XPDUTL("...pass 3 (of 5)...")
S IEN=0 F S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 D
.S RAD1520=$P($G(^ONCO(165.5,IEN,3)),U,20)
.S RAD1510=$P($G(^ONCO(165.5,IEN,"THY1")),U,43)
.S RAD3210=$P($G(^ONCO(165.5,IEN,"THY1")),U,44)
.S RAD1503=RAD1520
.D
..I RAD1510="" S RAD1507="" Q
..I RAD1510=0 S RAD1507=0 Q
..I RAD1510="88888" S RAD1507="888888" Q
..I RAD1510="99999" S RAD1507="999999" Q
..S RAD1507="0"_RAD1510 Q
.D
..I RAD3210="" S RAD1517="" Q
..I RAD3210=0 S RAD1517=0 Q
..I RAD3210="88888" S RAD1517="888888" Q
..I RAD3210="99999" S RAD1517="999999" Q
..S RAD1517="0"_RAD3210 Q
.S $P(^ONCO(165.5,IEN,"RAD18"),U,3)=RAD1503 ;PHASE 1 NUM OF FRACTIONS
.S $P(^ONCO(165.5,IEN,"RAD18"),U,7)=RAD1507 ;PHASE 1 TOTAL DOSE
.S $P(^ONCO(165.5,IEN,"RAD18"),U,14)=RAD1517 ;PHASE 2 TOTAL DOSE
.Q
;
D ^ONC2PSTN
;
Q
;
SETPIECE ;set the values for the new RAD fields - Pass 1
S $P(^ONCO(165.5,IEN,"RAD18"),U,4)=RAD1504 ;PHASE 1 RAD TX VOL
S $P(^ONCO(165.5,IEN,"RAD18"),U,5)=RAD1505 ;PHASE 1 RAD DRAINING LN
S $P(^ONCO(165.5,IEN,"RAD18"),U,1)=RAD1501 ;PHASE 1 RAD DOSE PER FRAC
S ONCDONE=1
Q
;
SETPASS2 ;set the values for the new RAD fields - Pass 2
S $P(^ONCO(165.5,IEN,"RAD18"),U,6)=RAD1506 ;PHASE 1 RAD TX MODALITY
S $P(^ONCO(165.5,IEN,"RAD18"),U,2)=RAD1502 ;PHASE 1 RAD EXT BEAM PLAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONC2PS10 11768 printed Apr 09, 2024@21:28:26 Page 2
ONC2PS10 ;Hines OIFO/RTK - Post-Install Routine for Patch ONC*2.2*10 ;11/27/18
+1 ;;2.2;ONCOLOGY;**10**;Jul 31, 2013;Build 20
+2 ;
+3 ;N RC
+4 ;DC production server Patch 10
+5 SET RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:86/cgi_bin/oncsrv.exe")
+6 ;DC test server, comment out for final release.
+7 ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:81/cgi_bin/oncsrv.exe")
+8 ;
+9 KILL ^DD(164.81,.001)
+10 KILL ^DD(164.82,.001)
+11 KILL ^DD(164.83,.001)
+12 KILL ^DD(164.84,.001)
+13 KILL ^DD(167.1,.001)
+14 KILL ^DD(167.5,.001)
+15 DO LVI
DO COC
DO RAD18
+16 QUIT
PRE ;Pre-init logic
+1 ;delete the old version of Extract file
+2 KILL ^ONCO(160.16)
+3 DO BMES^XPDUTL("Done removing old entries in file #160.16")
+4 KILL ^ONCO(164.44)
+5 KILL ^ONCO(165.9)
+6 QUIT
+7 ;
LVI ;need to reset any Lymph-Vascular Invasion with value of '1' for
+1 ; 2018+ cases, because new 2018 LVI has new values and '1' values
+2 ; could be 1 or new 2,3 or 4 values so must be reset
+3 SET ONCDXLVI=3171231
FOR
SET ONCDXLVI=$ORDER(^ONCO(165.5,"ADX",ONCDXLVI))
if ONCDXLVI'>0
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXLVI,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+5 IF $PIECE($GET(^ONCO(165.5,IEN,2)),"^",19)=1
SET $PIECE(^ONCO(165.5,IEN,2),"^",19)=""
End DoDot:2
End DoDot:1
+6 KILL ONCDXLVI
QUIT
COC ;Set the COC Accredited Flag field for 2018+ cases
+1 ; code to calculate/automatically set COC ACCREDITED FLAG (#7033) field
+2 ; this code will also automatically set the DERIVED SS2018 (#7012) fld
+3 SET ONCDXCOC=3171231
FOR
SET ONCDXCOC=$ORDER(^ONCO(165.5,"ADX",ONCDXCOC))
if ONCDXCOC'>0
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",ONCDXCOC,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+5 ;set=9 until were able to calc
SET $PIECE(^ONCO(165.5,IEN,"NCR18"),"^",13)=9
+6 IF $PIECE($GET(^ONCO(165.5,IEN,0)),U,16)<3180000
QUIT
+7 IF $$COCACC^ONCACDU2'="01"
SET $PIECE(^ONCO(165.5,IEN,"NCR18B"),"^",10)=0
+8 IF $$COCACC^ONCACDU2="01"
Begin DoDot:3
+9 NEW ONCCOC
SET ONCCOC=$PIECE($GET(^ONCO(165.5,IEN,0)),U,4)
+10 ;ANALYTIC, class of case 10-22 (iens in 165.3 of 2-9)
IF ((ONCCOC>1)&(ONCCOC<10))
SET $PIECE(^ONCO(165.5,IEN,"NCR18B"),"^",10)=1
+11 ;NON-ANALYTIC, class of case 30-43,99,00 (iens 10-22,1,24)
IF (ONCCOC=1)!(ONCCOC=24)!((ONCCOC>9)&(ONCCOC<23))
SET $PIECE(^ONCO(165.5,IEN,"NCR18B"),"^",10)=2
End DoDot:3
End DoDot:2
End DoDot:1
+12 ; not set for CoC ien 23
+13 KILL ONCDXCOC
QUIT
+14 QUIT
RAD18 ;populate the new 2018 Radiation fields according to the NAACCR
+1 ; crosswalk using the existing data in old Radiation fields
+2 ;
PASS1 ;
+1 DO BMES^XPDUTL("Populate 2018 Radation fields according to NAACCR crosswalk...")
+2 DO MES^XPDUTL("...pass 1 (of 5)...")
+3 SET ONCDONE=0
+4 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+5 SET DATEDX=$PIECE($GET(^ONCO(165.5,IEN,0)),U,16)
+6 SET TOPIEN=$PIECE($GET(^ONCO(165.5,IEN,2)),U,1)
if TOPIEN=""
QUIT
+7 SET TOPCOD=$PIECE($GET(^ONCO(164,TOPIEN,0)),U,2)
+8 ;remove the "."
SET ONCTPCD=$PIECE(TOPCOD,".",1)_$PIECE(TOPCOD,".",2)
+9 SET ONCHIST=$$HIST^ONCFUNC(IEN)
+10 SET HST14=$EXTRACT(ONCHIST,1,4)
SET ONCT3=$EXTRACT(ONCTPCD,2,5)
+11 SET RAD1540=$PIECE($GET(^ONCO(165.5,IEN,3)),U,21)
+12 SET RAD1570=$PIECE($GET(^ONCO(165.5,IEN,"BLA2")),U,18)
+13 SET RAD3200=$PIECE($GET(^ONCO(165.5,IEN,24)),U,9)
+14 IF RAD1540=1
SET RAD1504=1
SET RAD1505=1
SET RAD1501="00000"
DO SETPIECE
QUIT
+15 IF RAD1540=2
SET RAD1504=10
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+16 IF RAD1540=3
SET RAD1504=11
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+17 IF RAD1540=4
SET RAD1504=12
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+18 IF RAD1540=5
SET RAD1504=13
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+19 IF (RAD1540=6)!(RAD1540=7)
Begin DoDot:2
+20 IF ((HST14>9589)&(HST14<9730))
SET RAD1504=2
SET RAD1505=10
SET RAD1501="99999"
DO SETPIECE
QUIT
+21 IF (ONCT3="000")!((ONCT3>0)&(ONCT3<10))!((ONCT3>19)&(ONCT3<51))!((ONCT3>59)&(ONCT3<70))
SET RAD1504=16
SET RAD1505=2
SET RAD1501="99999"
DO SETPIECE
QUIT
+22 IF (ONCTPCD="C019")!((ONCT3>50)&(ONCT3<60))!((ONCT3>89)&(ONCT3<110))!(ONCTPCD="C140")
SET RAD1504=17
SET RAD1505=2
SET RAD1501="99999"
DO SETPIECE
QUIT
+23 IF ((ONCT3>109)&(ONCT3<120))
SET RAD1504=15
SET RAD1505=2
SET RAD1501="99999"
DO SETPIECE
QUIT
+24 IF (ONCTPCD="C129")!((ONCT3>129)&(ONCT3<140))!((ONCT3>319)&(ONCT3<330))
SET RAD1504=18
SET RAD1505=2
SET RAD1501="99999"
DO SETPIECE
QUIT
+25 SET RAD1504=22
SET RAD1505=2
SET RAD1501="99999"
DO SETPIECE
QUIT
End DoDot:2
IF ONCDONE=1
QUIT
+26 IF RAD1540=8
SET RAD1504=18
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+27 IF RAD1540=9
SET RAD1504=19
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+28 IF RAD1540=10
SET RAD1504=20
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+29 IF RAD1540=11
Begin DoDot:2
+30 IF ((HST14>9049)&(HST14<9056))
SET RAD1504=24
SET RAD1505=3
SET RAD1501="99999"
DO SETPIECE
QUIT
+31 IF ((HST14>8579)&(HST14<8589))
SET RAD1504=25
SET RAD1505=3
SET RAD1501="99999"
DO SETPIECE
QUIT
+32 SET RAD1504=26
SET RAD1505=3
SET RAD1501="99999"
DO SETPIECE
QUIT
End DoDot:2
IF ONCDONE=1
QUIT
+33 IF RAD1540=12
Begin DoDot:2
+34 IF ((HST14>9049)&(HST14<9056))
SET RAD1504=24
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+35 IF ((HST14>8579)&(HST14<8589))
SET RAD1504=25
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+36 SET RAD1504=23
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
End DoDot:2
IF ONCDONE=1
QUIT
+37 IF RAD1540=13
SET RAD1504=30
SET RAD1505=3
SET RAD1501="99999"
DO SETPIECE
QUIT
+38 IF RAD1540=14
SET RAD1504=31
SET RAD1505=6
SET RAD1501="99999"
DO SETPIECE
QUIT
+39 IF RAD1540=15
SET RAD1504=36
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+40 IF RAD1540=16
SET RAD1504=38
SET RAD1505=6
SET RAD1501="99999"
DO SETPIECE
QUIT
+41 IF RAD1540=17
SET RAD1504=42
SET RAD1505=6
SET RAD1501="99999"
DO SETPIECE
QUIT
+42 IF RAD1540=18
Begin DoDot:2
+43 IF ((ONCT3>169)&(ONCT3<180))
SET RAD1504=32
SET RAD1505=6
SET RAD1501="99999"
DO SETPIECE
QUIT
+44 IF ((ONCT3>179)&(ONCT3<190))
SET RAD1504=33
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+45 SET RAD1504=39
SET RAD1505=6
SET RAD1501="99999"
DO SETPIECE
QUIT
End DoDot:2
IF ONCDONE=1
QUIT
+46 IF RAD1540=19
Begin DoDot:2
+47 IF ((RAD1570>35)&(RAD1570<42))&(RAD3200=1)
SET RAD1504=28
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+48 SET RAD1504=27
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
End DoDot:2
IF ONCDONE=1
QUIT
+49 IF RAD1540=20
SET RAD1504=27
SET RAD1505=5
SET RAD1501="99999"
DO SETPIECE
QUIT
+50 IF RAD1540=21
SET RAD1504=29
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+51 IF RAD1540=22
SET RAD1504=29
SET RAD1505=5
SET RAD1501="99999"
DO SETPIECE
QUIT
+52 IF RAD1540=23
SET RAD1504=65
SET RAD1505=10
SET RAD1501="99999"
DO SETPIECE
QUIT
+53 IF RAD1540=24
SET RAD1504=66
SET RAD1505=10
SET RAD1501="99999"
DO SETPIECE
QUIT
+54 IF RAD1540=25
SET RAD1504=54
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+55 IF RAD1540=26
SET RAD1504=53
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+56 IF RAD1540=27
SET RAD1504=56
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+57 IF RAD1540=28
SET RAD1504=57
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+58 IF RAD1540=29
SET RAD1504=58
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+59 IF RAD1540=30
Begin DoDot:2
+60 IF ((HST14>9589)&(HST14<9730))
SET RAD1504=7
SET RAD1505=10
SET RAD1501="99999"
DO SETPIECE
QUIT
+61 IF "C180^C181^C182^C183^C184^C185^C186^C187^C188^C189"[ONCTPCD
SET RAD1504=33
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+62 IF ONCTPCD="C209"
SET RAD1504=34
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+63 IF "C210^C211^C212^C213^C214^C215^C216^C217^C218"[ONCTPCD
SET RAD1504=35
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+64 IF "C510^C511^C512^C518"[ONCTPCD
SET RAD1504=51
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+65 IF ONCTPCD="C529"
SET RAD1504=52
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+66 IF ((ONCT3>529)&(ONCT3<560))
SET RAD1504=50
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+67 IF ONCTPCD="C619"
SET RAD1504=44
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+68 IF ONCTPCD="C669"
SET RAD1504=43
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+69 IF "C670^C671^C672^C673^C674^C675^C676^C677^C678^C679"[ONCTPCD
SET RAD1504=40
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+70 SET RAD1504=59
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
End DoDot:2
IF ONCDONE=1
QUIT
+71 IF RAD1540=31
SET RAD1504=61
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+72 IF RAD1540=32
SET RAD1504=62
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+73 IF RAD1540=33
SET RAD1504=63
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+74 IF RAD1540=34
SET RAD1504=64
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+75 IF RAD1540=35
SET RAD1504=40
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+76 IF RAD1540=36
SET RAD1504=44
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+77 IF RAD1540=37
SET RAD1504=50
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+78 IF RAD1540=38
SET RAD1504=55
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+79 IF RAD1540=39
SET RAD1504=60
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+80 IF RAD1540=40
SET RAD1504=67
SET RAD1505=10
SET RAD1501="99999"
DO SETPIECE
QUIT
+81 IF RAD1540=43
SET RAD1504=14
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+82 IF RAD1540=44
SET RAD1504=44
SET RAD1505=1
SET RAD1501="99999"
DO SETPIECE
QUIT
+83 IF RAD1540=45
SET RAD1504=21
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+84 IF RAD1540=46
SET RAD1504=9
SET RAD1505=10
SET RAD1501="99999"
DO SETPIECE
QUIT
+85 IF RAD1540=41
Begin DoDot:2
+86 IF ONCTPCD="C669"
SET RAD1504=43
SET RAD1505=7
SET RAD1501="99999"
DO SETPIECE
QUIT
+87 IF ONCTPCD="C680"
SET RAD1504=46
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+88 IF "C600^C601^C602^C603^C604^C605^C606^C607^C608^C609"[ONCTPCD
SET RAD1504=47
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+89 IF ((ONCT3>619)&(ONCT3<640))
SET RAD1504=48
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+90 SET RAD1504=69
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
End DoDot:2
IF ONCDONE=1
QUIT
+91 IF RAD1540=42
SET RAD1504=70
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+92 IF RAD1540'=""
SET RAD1504=68
SET RAD1505=11
SET RAD1501="99999"
DO SETPIECE
QUIT
+93 QUIT
End DoDot:1
+94 ;
PASS2 ;
+1 DO MES^XPDUTL("...pass 2 (of 5)...")
+2 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET DATEDX=$PIECE($GET(^ONCO(165.5,IEN,0)),U,16)
+4 SET TOPIEN=$PIECE($GET(^ONCO(165.5,IEN,2)),U,1)
if TOPIEN=""
QUIT
+5 SET TOPCOD=$PIECE($GET(^ONCO(164,TOPIEN,0)),U,2)
+6 ;remove the "."
SET ONCTPCD=$PIECE(TOPCOD,".",1)_$PIECE(TOPCOD,".",2)
+7 SET ONCHIST=$$HIST^ONCFUNC(IEN)
+8 SET HST14=$EXTRACT(ONCHIST,1,4)
SET ONCT3=$EXTRACT(ONCTPCD,2,5)
+9 SET RAD1570=$PIECE($GET(^ONCO(165.5,IEN,"BLA2")),U,18)
+10 IF RAD1570=""
QUIT
+11 IF RAD1570=1
SET RAD1506=1
SET RAD1502=1
DO SETPASS2
QUIT
+12 IF (RAD1570=20)!(RAD1570=29)
SET RAD1506=2
SET RAD1502=2
DO SETPASS2
QUIT
+13 IF RAD1570=21
SET RAD1506=3
SET RAD1502=3
DO SETPASS2
QUIT
+14 IF (RAD1570=22)!(RAD1570=23)!(RAD1570=24)!(RAD1570=25)!(RAD1570=26)!(RAD1570=27)
SET RAD1506=3
SET RAD1502=2
DO SETPASS2
QUIT
+15 IF RAD1570=28
SET RAD1506=5
SET RAD1502=4
DO SETPASS2
QUIT
+16 IF RAD1570=30
SET RAD1506=6
SET RAD1502=2
DO SETPASS2
QUIT
+17 IF RAD1570=31
SET RAD1506=3
SET RAD1502=6
DO SETPASS2
QUIT
+18 IF RAD1570=32
SET RAD1506=2
SET RAD1502=5
DO SETPASS2
QUIT
+19 IF RAD1570=33
SET RAD1506=4
SET RAD1502=2
DO SETPASS2
QUIT
+20 IF RAD1570=34
SET RAD1506=3
SET RAD1502=7
DO SETPASS2
QUIT
+21 IF RAD1570=35
SET RAD1506=3
SET RAD1502=8
DO SETPASS2
QUIT
+22 IF RAD1570=36
SET RAD1506=3
SET RAD1502=9
DO SETPASS2
QUIT
+23 IF RAD1570=37
SET RAD1506=8
SET RAD1502=12
DO SETPASS2
QUIT
+24 IF RAD1570=38
SET RAD1506=9
SET RAD1502=12
DO SETPASS2
QUIT
+25 IF RAD1570=39
SET RAD1506=10
SET RAD1502=12
DO SETPASS2
QUIT
+26 IF RAD1570=40
SET RAD1506=11
SET RAD1502=12
DO SETPASS2
QUIT
+27 IF RAD1570=41
SET RAD1506=12
SET RAD1502=12
DO SETPASS2
QUIT
+28 IF (RAD1570=42)!(RAD1570=43)
SET RAD1506=14
SET RAD1502=12
DO SETPASS2
QUIT
+29 IF RAD1570=44
SET RAD1506=16
SET RAD1502=12
DO SETPASS2
QUIT
+30 IF RAD1570=45
SET RAD1506=17
SET RAD1502=12
DO SETPASS2
QUIT
+31 IF (RAD1570=46)!(RAD1570=47)!(RAD1570=18)
SET RAD1506=18
SET RAD1502=13
DO SETPASS2
QUIT
+32 IF RAD1570=19
SET RAD1506=18
SET RAD1502=14
DO SETPASS2
QUIT
+33 IF ((RAD1570>1)&(RAD1570<18))
SET RAD1506=18
SET RAD1502=13
DO SETPASS2
QUIT
+34 QUIT
End DoDot:1
+35 ;
PASS3 ;
+1 DO MES^XPDUTL("...pass 3 (of 5)...")
+2 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET RAD1520=$PIECE($GET(^ONCO(165.5,IEN,3)),U,20)
+4 SET RAD1510=$PIECE($GET(^ONCO(165.5,IEN,"THY1")),U,43)
+5 SET RAD3210=$PIECE($GET(^ONCO(165.5,IEN,"THY1")),U,44)
+6 SET RAD1503=RAD1520
+7 Begin DoDot:2
+8 IF RAD1510=""
SET RAD1507=""
QUIT
+9 IF RAD1510=0
SET RAD1507=0
QUIT
+10 IF RAD1510="88888"
SET RAD1507="888888"
QUIT
+11 IF RAD1510="99999"
SET RAD1507="999999"
QUIT
+12 SET RAD1507="0"_RAD1510
QUIT
End DoDot:2
+13 Begin DoDot:2
+14 IF RAD3210=""
SET RAD1517=""
QUIT
+15 IF RAD3210=0
SET RAD1517=0
QUIT
+16 IF RAD3210="88888"
SET RAD1517="888888"
QUIT
+17 IF RAD3210="99999"
SET RAD1517="999999"
QUIT
+18 SET RAD1517="0"_RAD3210
QUIT
End DoDot:2
+19 ;PHASE 1 NUM OF FRACTIONS
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,3)=RAD1503
+20 ;PHASE 1 TOTAL DOSE
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,7)=RAD1507
+21 ;PHASE 2 TOTAL DOSE
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,14)=RAD1517
+22 QUIT
End DoDot:1
+23 ;
+24 DO ^ONC2PSTN
+25 ;
+26 QUIT
+27 ;
SETPIECE ;set the values for the new RAD fields - Pass 1
+1 ;PHASE 1 RAD TX VOL
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,4)=RAD1504
+2 ;PHASE 1 RAD DRAINING LN
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,5)=RAD1505
+3 ;PHASE 1 RAD DOSE PER FRAC
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,1)=RAD1501
+4 SET ONCDONE=1
+5 QUIT
+6 ;
SETPASS2 ;set the values for the new RAD fields - Pass 2
+1 ;PHASE 1 RAD TX MODALITY
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,6)=RAD1506
+2 ;PHASE 1 RAD EXT BEAM PLAN
SET $PIECE(^ONCO(165.5,IEN,"RAD18"),U,2)=RAD1502
+3 QUIT
