ONCRFNR ;Hines OIFO/GWB; REASON FOR NO RADIATION (165.5,75) ;06/23/10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
;REASON FOR NO RADIATION (165.5,75)
N COC,RAD,TXDT
S RAD=$P($G(^ONCO(165.5,DA,3)),U,6)
K RFNRMSG
I RFNR=8 D
.Q:$P(^ONCO(165.5,DA,3),U,4)=8888888
.S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
.K ^ONCO(165.5,"ATX",DA,TXDT)
.S $P(^ONCO(165.5,DA,3),U,4)=8888888 D RADDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"8888888R")=""
.S RFNRMSG="DATE RADIATION STARTED changed to 88/88/8888"
I RFNR'=8,RAD=0 D
.Q:$P(^ONCO(165.5,DA,3),U,4)="0000000"
.S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
.K ^ONCO(165.5,"ATX",DA,TXDT)
.S $P(^ONCO(165.5,DA,3),U,4)="0000000" D RADDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"0000000R")=""
.S RFNRMSG="DATE RADIATION STARTED changed to 00/00/0000"
I RFNR'=8,RAD=9 D
.Q:$P(^ONCO(165.5,DA,3),U,4)=9999999
.S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
.K ^ONCO(165.5,"ATX",DA,TXDT)
.S $P(^ONCO(165.5,DA,3),U,4)=9999999 D RADDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"9999999R")=""
.S RFNRMSG="DATE RADIATION STARTED changed to 99/99/9999"
S COC=$E($$GET1^DIQ(165.5,DA,.04),1,2)
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D
.I RFNR=8 S $P(^ONCO(165.5,DA,3.1),U,13)=8888888
.I RFNR'=8 S $P(^ONCO(165.5,DA,3.1),U,13)="0000000"
D RADDT^ONCATF1
Q
;
CLEANUP ;Cleanup
K DA,RFNR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCRFNR 1355 printed Dec 13, 2024@02:27:40 Page 2
ONCRFNR ;Hines OIFO/GWB; REASON FOR NO RADIATION (165.5,75) ;06/23/10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 ;REASON FOR NO RADIATION (165.5,75)
+4 NEW COC,RAD,TXDT
+5 SET RAD=$PIECE($GET(^ONCO(165.5,DA,3)),U,6)
+6 KILL RFNRMSG
+7 IF RFNR=8
Begin DoDot:1
+8 if $PIECE(^ONCO(165.5,DA,3),U,4)=8888888
QUIT
+9 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,4)_"R"
+10 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+11 SET $PIECE(^ONCO(165.5,DA,3),U,4)=8888888
DO RADDT^ONCATF1
+12 SET ^ONCO(165.5,"ATX",DA,"8888888R")=""
+13 SET RFNRMSG="DATE RADIATION STARTED changed to 88/88/8888"
End DoDot:1
+14 IF RFNR'=8
IF RAD=0
Begin DoDot:1
+15 if $PIECE(^ONCO(165.5,DA,3),U,4)="0000000"
QUIT
+16 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,4)_"R"
+17 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+18 SET $PIECE(^ONCO(165.5,DA,3),U,4)="0000000"
DO RADDT^ONCATF1
+19 SET ^ONCO(165.5,"ATX",DA,"0000000R")=""
+20 SET RFNRMSG="DATE RADIATION STARTED changed to 00/00/0000"
End DoDot:1
+21 IF RFNR'=8
IF RAD=9
Begin DoDot:1
+22 if $PIECE(^ONCO(165.5,DA,3),U,4)=9999999
QUIT
+23 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,4)_"R"
+24 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+25 SET $PIECE(^ONCO(165.5,DA,3),U,4)=9999999
DO RADDT^ONCATF1
+26 SET ^ONCO(165.5,"ATX",DA,"9999999R")=""
+27 SET RFNRMSG="DATE RADIATION STARTED changed to 99/99/9999"
End DoDot:1
+28 SET COC=$EXTRACT($$GET1^DIQ(165.5,DA,.04),1,2)
+29 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
Begin DoDot:1
+30 IF RFNR=8
SET $PIECE(^ONCO(165.5,DA,3.1),U,13)=8888888
+31 IF RFNR'=8
SET $PIECE(^ONCO(165.5,DA,3.1),U,13)="0000000"
End DoDot:1
+32 DO RADDT^ONCATF1
+33 QUIT
+34 ;
CLEANUP ;Cleanup
+1 KILL DA,RFNR
