source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCRFNR.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1ONCRFNR ;Hines OIFO/GWB; REASON FOR NO RADIATION; 08/02/06
2 ;;2.11;ONCOLOGY;**46**;Mar 07, 1995;Build 39
3 ;
4 ;REASON FOR NO RADIATION (165.5,75)
5 S RAD=$P($G(^ONCO(165.5,DA,3)),U,6)
6 K RFNRMSG
7 I RFNR=8 D
8 .Q:$P(^ONCO(165.5,DA,3),U,4)=8888888
9 .S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
10 .K ^ONCO(165.5,"ATX",DA,TXDT)
11 .S $P(^ONCO(165.5,DA,3),U,4)=8888888 D RADDT^ONCATF1
12 .S ^ONCO(165.5,"ATX",DA,"8888888R")=""
13 .S RFNRMSG="DATE RADIATION STARTED changed to 88/88/8888"
14 I RFNR'=8,RAD=0 D
15 .Q:$P(^ONCO(165.5,DA,3),U,4)="0000000"
16 .S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
17 .K ^ONCO(165.5,"ATX",DA,TXDT)
18 .S $P(^ONCO(165.5,DA,3),U,4)="0000000" D RADDT^ONCATF1
19 .S ^ONCO(165.5,"ATX",DA,"0000000R")=""
20 .S RFNRMSG="DATE RADIATION STARTED changed to 00/00/0000"
21 I RFNR'=8,RAD=9 D
22 .Q:$P(^ONCO(165.5,DA,3),U,4)=9999999
23 .S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
24 .K ^ONCO(165.5,"ATX",DA,TXDT)
25 .S $P(^ONCO(165.5,DA,3),U,4)=9999999 D RADDT^ONCATF1
26 .S ^ONCO(165.5,"ATX",DA,"9999999R")=""
27 .S RFNRMSG="DATE RADIATION STARTED changed to 99/99/9999"
28 S COC=$P($G(^ONCO(165.5,DA,0)),U,4)
29 I (COC=0)!(COC=3)!(COC=6) D
30 .I RFNR=8 S $P(^ONCO(165.5,DA,3.1),U,13)=8888888
31 .I RFNR'=8 S $P(^ONCO(165.5,DA,3.1),U,13)="0000000"
32 D RADDT^ONCATF1
33 Q
Note: See TracBrowser for help on using the repository browser.