RASTREQN ;HIRMFO/GJC-Status Requirement check for Radiopharms ;11/18/97 15:13
;;5.0;Radiology/Nuclear Medicine;**40,65**;Mar 16, 1998;Build 8
;
;supported IA #10104 reference to UP^XLFSTR and REPEAT^XLFSTR
;Supported IA #2056 refernce to GETS^DIQ
;
; *** 'RASTREQN' is called from routine: 'RASTREQ' ***
EN1(RADIO,RAJ) ; Check if all the required radiopharmaceutical data has
; been entered for this particular Examination Status.
; *=*=*= Kills 'X' if the status cannot be updated =*=*=*
; Input: 'RADIO' -> .5 node of the examination status (Radiopharms req)
; 'RAJ' -> 0 node of the examination
;
; NOTE: RAMES1 is set in RASTREQ^RASTREQ subroutine. Only the 'Status
; Tracking Of Exams' option displays which required fields are not
; populated for the next available Exam Status.
;
;----------------------------------------------------------------------
; Determine if 'Radiopharmaceutical' is required
; RAPRI defined in [RA STATUS CHANGE] & [RA EXAM EDIT]
;
Q:"N"[$P(RADIO,"^") ; Rpharms & Dosages NOT Req'd (either 'no' or null)
N RAPROC S RAPROC(0)=$G(^RAMIS(71,+$P(RAJ,"^",2),0))
Q:$P(RAPROC(0),"^",2)=1 ; Never ask Rpharms & Dosages
;----------------------------------------------------------------------
N RA702 S RA702=+$P(RAJ,"^",28) ; ien in NUC MED EXAM DATA (70.2) file
N RA7021,RACNT,RAI,RAMES2,RAREQ,RAZ S RAI=0
I 'RA702,($P(RADIO,"^")="Y") D Q
. K X S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1
. Q
F S RAI=$O(^RADPTN(RA702,"NUC",RAI)) Q:RAI'>0 D
. S RA7021=$G(^RADPTN(RA702,"NUC",RAI,0)),RACNT=0
. S RAMES2="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !,""Radiopharmaceutical: "",$$EN1^RAPSAPI(+$P(RA7021,""^""),.01)"
. I $P(RADIO,"^")="Y",($P(RA7021,"^")=""!($P(RA7021,"^",7)="")) D
.. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2
.. I $P(RA7021,"^")="" S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1
.. I $P(RA7021,"^",7)="" S RAZ="Dosage" X:$D(RAMES1) RAMES1
.. Q
. I $P(RADIO,"^",3)="Y",($P(RA7021,"^",4)="") D
.. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2
.. S RAZ="Activity Drawn" X:$D(RAMES1) RAMES1 K X
.. Q
. I $P(RADIO,"^",4)="Y",($P(RA7021,"^",5)=""!($P(RA7021,"^",6)="")) D
.. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2
.. I $P(RA7021,"^",5)="" S RAZ="Date/Time Drawn" X:$D(RAMES1) RAMES1
.. I $P(RA7021,"^",6)="" S RAZ="Person Who Measured Dose" X:$D(RAMES1) RAMES1
.. Q
. I $P(RADIO,"^",5)="Y",($P(RA7021,"^",8)=""!($P(RA7021,"^",9)="")) D
.. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2
.. I $P(RA7021,"^",8)="" S RAZ="Date/Time Dose Administered" X:$D(RAMES1) RAMES1
.. I $P(RA7021,"^",9)="" S RAZ="Person Who Administered Dose" X:$D(RAMES1) RAMES1
.. Q
. I $P(RADIO,"^",7)="Y",($P(RA7021,"^",11)=""!($P(RA7021,"^",12)="")) D
.. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2
.. I $P(RA7021,"^",11)="" S RAZ="Route Of Administration" X:$D(RAMES1) RAMES1
.. I $P(RA7021,"^",12)="" S RAZ="Site Of Administration" X:$D(RAMES1) RAMES1
.. Q
. I $P(RADIO,"^",8)="Y",($P(RA7021,"^",13)="") D
.. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2
.. S RAZ="Lot No." X:$D(RAMES1) RAMES1 K X
.. Q
. I $P(RADIO,"^",9)="Y",($P(RA7021,"^",14)=""!($P(RA7021,"^",15)="")) D
.. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2
.. I $P(RA7021,"^",14)="" S RAZ="Volume" X:$D(RAMES1) RAMES1
.. I $P(RA7021,"^",15)="" S RAZ="Form" X:$D(RAMES1) RAMES1
.. Q
. Q
Q
NORADIO(RAPRI,RANXT72) ; This function will determine if Rpharm
; fields from the 'Nuc Med Exam Data' file [ ^RADPTN( ] will be asked.
; Input : 'RANXT72' -> .6 node of the 'Next' Exam Status
; : 'RAPRI' -> IEN of the procedure for this exam
; Output: '1' bypass Rpharm questions, else (0) ask
Q:$TR($$UP^XLFSTR(RANXT72(.6)),"^","")="" 1 ; null or '^'s
; ------------------- Variable Definitions ----------------------------
; 'RAPROC(2)': ask Rpharm & Dosages parameter for this procedure
;----------------------------------------------------------------------
N RAPROC S RAPROC(2)=$P($G(^RAMIS(71,RAPRI,0)),"^",2)
;----------------------------------------------------------------------
; * following conditions apply for descendants exams & single exams *
; * Number 1: Suppress Rpharm = 1 even if 'Rpharms/Dose' Req'd *
; * Number 2: Suppress Rpharm = null or 0, 'Rpharm/Dose' not req'd *
Q:RAPROC(2)=1 1
Q:"N"[$P(RANXT72(.6),"^") 1
;----------------------------------------------------------------------
Q 0 ; ask Rpharm & Dosage fields
DISDEF(RADA) ; Display Radiopharmaceutical default data
; called from input templs: [RASTATUS CHANGE] and [RA EXAM EDIT]
; Input: RADA -> ien of the Nuc Med Exam Data record
Q:'$O(^RADPTN(RADA,"NUC",0)) ; Radiopharms missing, no data
N RADARY,RADEUC,RAFLDS,RAIENS,RAOPUT,X,Y W !
S RAIENS="" D GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D
. Q:$P(RAIENS,",",2)="" ; top-level of the file
. S (RADEUC,RAFLDS)=0
. F S RAFLDS=$O(RADARY(70.21,RAIENS,RAFLDS)) Q:RAFLDS'>0 D Q:$D(DIRUT)
.. I RAFLDS=.01 D
... S RADEUC=0 W !,$G(RADARY(70.21,RAIENS,RAFLDS,"E"))
... W !,$$REPEAT^XLFSTR("-",$L($G(RADARY(70.21,RAIENS,RAFLDS,"E")))),!
... Q
.. E D
... S RADEUC=RADEUC+1
... S RAOPUT=$$TRAN(RAFLDS)_$G(RADARY(70.21,RAIENS,RAFLDS,"E"))_$S(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:"")
... W:RADEUC=1 $E(RAOPUT,1,38) W:RADEUC=2 ?39,$E(RAOPUT,1,39)
... Q
.. W:RADEUC'=2&($O(RADARY(70.21,RAIENS,RAFLDS))="") !
.. W:RADEUC=2 ! S:RADEUC=2 RADEUC=0
.. Q
. Q
Q
TRAN(X) ; Translate field name to a shorter length.
Q:X=2 "Dose (MD Override): " Q:X=3 "Prescriber: "
Q:X=4 "Activity Drawn: " Q:X=5 "Drawn: " Q:X=6 "Measured By: "
Q:X=7 "Dose Adm'd: " Q:X=8 "Date Adm'd: " Q:X=9 "Adm'd By: "
Q:X=10 "Witness: " Q:X=11 "Route: " Q:X=12 "Site: "
Q:X=12.5 "Site Text: " Q:X=13 "Lot #: " Q:X=14 "Volume: "
Q:X=15 "Form: "
VALDOS(RALOW,RAHI,X,RABACKTO,RAGOTO,RALASTAG,RAWARN) ;validate drawn/dose
; Called from [RA STATUS CHANGE] and [RA EXAM EDIT] input templates.
; Validate the value for either :
; ACTIVITY DRAWN (fld 4, DD: 70.21)
; DOSE (fld 7, DD: 70.21)
; If there are limits on the Dosage, validate.
; If validate fails, ask user if the invalid value is to be accepted.
; If yes, proceed.
; If no, re-ask DOSE.
; Input: RAHI = Upper limit on dosage
; RALOW = Lower limit on dosage
; X = Value user input
; RABACKTO = Previous Line tag to loop back to if need re-ask
; RAGOTO = Default linetag to proceed to if within range
; RALASTAG = Last linetag in this edit template if early out
; RAWARN = display/not the warning msg -- 0=no, 1=yes
;
; Output: RAY = linetag to proceed to after exiting this check
;
N RAY,RAYN S RAY="" I X']"" S RAY=RAGOTO G KVAL
S:RALOW=""&(RAHI="") RAY=RAGOTO
S:RALOW]""&(RAHI="")&(X'<RALOW) RAY=RAGOTO
S:RALOW=""&(RAHI]"")&(X'>RAHI) RAY=RAGOTO
S:RALOW]""&(RAHI]"")&(X'<RALOW)&(X'>RAHI) RAY=RAGOTO
I RAY="" D
. F D Q:RAY]""
.. I $O(^RA(79,RAMDIV,"RWARN",0)) D:RAWARN
... N I S I=0
... F S I=$O(^RA(79,RAMDIV,"RWARN",I)) Q:I'>0 W !,$G(^(I,0))
... Q
.. E D:RAWARN
... W !,"This dose requires a written, dated and signed directive by"
... W !,"a physician."
... Q
.. W !!?3,"Are you sure (Y/N)?: N//" R RAYN:DTIME
.. I '$T!(RAYN["^") S RAY=RALASTAG Q
.. S RAYN=$S(RAYN']"":"N",1:$$UP^XLFSTR($E(RAYN)))
.. S RAY=$S(RAYN="N":RABACKTO,RAYN="Y":RAGOTO,1:"")
.. I RAY="" W !!?3,"Enter 'Yes' if this value is acceptable, or 'No' if this field is to be",!?3,"re-edited.",$C(7)
.. Q
. Q
KVAL K RABACKTO,RAGOTO,RALASTAG,RAWARN
Q RAY
RASTREQN ;HIRMFO/GJC-Status Requirement check for Radiopharms ;11/18/97 15:13
+1 ;;5.0;Radiology/Nuclear Medicine;**40,65**;Mar 16, 1998;Build 8
+2 ;
+3 ;supported IA #10104 reference to UP^XLFSTR and REPEAT^XLFSTR
+4 ;Supported IA #2056 refernce to GETS^DIQ
+5 ;
+6 ; *** 'RASTREQN' is called from routine: 'RASTREQ' ***
EN1(RADIO,RAJ) ; Check if all the required radiopharmaceutical data has
+1 ; been entered for this particular Examination Status.
+2 ; *=*=*= Kills 'X' if the status cannot be updated =*=*=*
+3 ; Input: 'RADIO' -> .5 node of the examination status (Radiopharms req)
+4 ; 'RAJ' -> 0 node of the examination
+5 ;
+6 ; NOTE: RAMES1 is set in RASTREQ^RASTREQ subroutine. Only the 'Status
+7 ; Tracking Of Exams' option displays which required fields are not
+8 ; populated for the next available Exam Status.
+9 ;
+10 ;----------------------------------------------------------------------
+11 ; Determine if 'Radiopharmaceutical' is required
+12 ; RAPRI defined in [RA STATUS CHANGE] & [RA EXAM EDIT]
+13 ;
+14 ; Rpharms & Dosages NOT Req'd (either 'no' or null)
IF "N"[$PIECE(RADIO,"^")
QUIT
+15 NEW RAPROC
SET RAPROC(0)=$GET(^RAMIS(71,+$PIECE(RAJ,"^",2),0))
+16 ; Never ask Rpharms & Dosages
IF $PIECE(RAPROC(0),"^",2)=1
QUIT
+17 ;----------------------------------------------------------------------
+18 ; ien in NUC MED EXAM DATA (70.2) file
NEW RA702
SET RA702=+$PIECE(RAJ,"^",28)
+19 NEW RA7021,RACNT,RAI,RAMES2,RAREQ,RAZ
SET RAI=0
+20 IF 'RA702
IF ($PIECE(RADIO,"^")="Y")
Begin DoDot:1
+21 KILL X
SET RAZ="Radiopharmaceutical"
IF $DATA(RAMES1)
XECUTE RAMES1
+22 QUIT
End DoDot:1
QUIT
+23 FOR
SET RAI=$ORDER(^RADPTN(RA702,"NUC",RAI))
IF RAI'>0
QUIT
Begin DoDot:1
+24 SET RA7021=$GET(^RADPTN(RA702,"NUC",RAI,0))
SET RACNT=0
+25 SET RAMES2="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !,""Radiopharmaceutical: "",$$EN1^RAPSAPI(+$P(RA7021,""^""),.01)"
+26 IF $PIECE(RADIO,"^")="Y"
IF ($PIECE(RA7021,"^")=""!($PIECE(RA7021,"^",7)=""))
Begin DoDot:2
+27 KILL X
SET RACNT=RACNT+1
IF $DATA(RAMES1)&(RACNT=1)
XECUTE RAMES2
+28 IF $PIECE(RA7021,"^")=""
SET RAZ="Radiopharmaceutical"
IF $DATA(RAMES1)
XECUTE RAMES1
+29 IF $PIECE(RA7021,"^",7)=""
SET RAZ="Dosage"
IF $DATA(RAMES1)
XECUTE RAMES1
+30 QUIT
End DoDot:2
+31 IF $PIECE(RADIO,"^",3)="Y"
IF ($PIECE(RA7021,"^",4)="")
Begin DoDot:2
+32 SET RACNT=RACNT+1
IF $DATA(RAMES1)&(RACNT=1)
XECUTE RAMES2
+33 SET RAZ="Activity Drawn"
IF $DATA(RAMES1)
XECUTE RAMES1
KILL X
+34 QUIT
End DoDot:2
+35 IF $PIECE(RADIO,"^",4)="Y"
IF ($PIECE(RA7021,"^",5)=""!($PIECE(RA7021,"^",6)=""))
Begin DoDot:2
+36 KILL X
SET RACNT=RACNT+1
IF $DATA(RAMES1)&(RACNT=1)
XECUTE RAMES2
+37 IF $PIECE(RA7021,"^",5)=""
SET RAZ="Date/Time Drawn"
IF $DATA(RAMES1)
XECUTE RAMES1
+38 IF $PIECE(RA7021,"^",6)=""
SET RAZ="Person Who Measured Dose"
IF $DATA(RAMES1)
XECUTE RAMES1
+39 QUIT
End DoDot:2
+40 IF $PIECE(RADIO,"^",5)="Y"
IF ($PIECE(RA7021,"^",8)=""!($PIECE(RA7021,"^",9)=""))
Begin DoDot:2
+41 KILL X
SET RACNT=RACNT+1
IF $DATA(RAMES1)&(RACNT=1)
XECUTE RAMES2
+42 IF $PIECE(RA7021,"^",8)=""
SET RAZ="Date/Time Dose Administered"
IF $DATA(RAMES1)
XECUTE RAMES1
+43 IF $PIECE(RA7021,"^",9)=""
SET RAZ="Person Who Administered Dose"
IF $DATA(RAMES1)
XECUTE RAMES1
+44 QUIT
End DoDot:2
+45 IF $PIECE(RADIO,"^",7)="Y"
IF ($PIECE(RA7021,"^",11)=""!($PIECE(RA7021,"^",12)=""))
Begin DoDot:2
+46 KILL X
SET RACNT=RACNT+1
IF $DATA(RAMES1)&(RACNT=1)
XECUTE RAMES2
+47 IF $PIECE(RA7021,"^",11)=""
SET RAZ="Route Of Administration"
IF $DATA(RAMES1)
XECUTE RAMES1
+48 IF $PIECE(RA7021,"^",12)=""
SET RAZ="Site Of Administration"
IF $DATA(RAMES1)
XECUTE RAMES1
+49 QUIT
End DoDot:2
+50 IF $PIECE(RADIO,"^",8)="Y"
IF ($PIECE(RA7021,"^",13)="")
Begin DoDot:2
+51 SET RACNT=RACNT+1
IF $DATA(RAMES1)&(RACNT=1)
XECUTE RAMES2
+52 SET RAZ="Lot No."
IF $DATA(RAMES1)
XECUTE RAMES1
KILL X
+53 QUIT
End DoDot:2
+54 IF $PIECE(RADIO,"^",9)="Y"
IF ($PIECE(RA7021,"^",14)=""!($PIECE(RA7021,"^",15)=""))
Begin DoDot:2
+55 KILL X
SET RACNT=RACNT+1
IF $DATA(RAMES1)&(RACNT=1)
XECUTE RAMES2
+56 IF $PIECE(RA7021,"^",14)=""
SET RAZ="Volume"
IF $DATA(RAMES1)
XECUTE RAMES1
+57 IF $PIECE(RA7021,"^",15)=""
SET RAZ="Form"
IF $DATA(RAMES1)
XECUTE RAMES1
+58 QUIT
End DoDot:2
+59 QUIT
End DoDot:1
+60 QUIT
NORADIO(RAPRI,RANXT72) ; This function will determine if Rpharm
+1 ; fields from the 'Nuc Med Exam Data' file [ ^RADPTN( ] will be asked.
+2 ; Input : 'RANXT72' -> .6 node of the 'Next' Exam Status
+3 ; : 'RAPRI' -> IEN of the procedure for this exam
+4 ; Output: '1' bypass Rpharm questions, else (0) ask
+5 ; null or '^'s
IF $TRANSLATE($$UP^XLFSTR(RANXT72(.6)),"^","")=""
QUIT 1
+6 ; ------------------- Variable Definitions ----------------------------
+7 ; 'RAPROC(2)': ask Rpharm & Dosages parameter for this procedure
+8 ;----------------------------------------------------------------------
+9 NEW RAPROC
SET RAPROC(2)=$PIECE($GET(^RAMIS(71,RAPRI,0)),"^",2)
+10 ;----------------------------------------------------------------------
+11 ; * following conditions apply for descendants exams & single exams *
+12 ; * Number 1: Suppress Rpharm = 1 even if 'Rpharms/Dose' Req'd *
+13 ; * Number 2: Suppress Rpharm = null or 0, 'Rpharm/Dose' not req'd *
+14 IF RAPROC(2)=1
QUIT 1
+15 IF "N"[$PIECE(RANXT72(.6),"^")
QUIT 1
+16 ;----------------------------------------------------------------------
+17 ; ask Rpharm & Dosage fields
QUIT 0
DISDEF(RADA) ; Display Radiopharmaceutical default data
+1 ; called from input templs: [RASTATUS CHANGE] and [RA EXAM EDIT]
+2 ; Input: RADA -> ien of the Nuc Med Exam Data record
+3 ; Radiopharms missing, no data
IF '$ORDER(^RADPTN(RADA,"NUC",0))
QUIT
+4 NEW RADARY,RADEUC,RAFLDS,RAIENS,RAOPUT,X,Y
WRITE !
+5 SET RAIENS=""
DO GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
+6 FOR
SET RAIENS=$ORDER(RADARY(70.21,RAIENS))
IF RAIENS=""
QUIT
Begin DoDot:1
+7 ; top-level of the file
IF $PIECE(RAIENS,",",2)=""
QUIT
+8 SET (RADEUC,RAFLDS)=0
+9 FOR
SET RAFLDS=$ORDER(RADARY(70.21,RAIENS,RAFLDS))
IF RAFLDS'>0
QUIT
Begin DoDot:2
+10 IF RAFLDS=.01
Begin DoDot:3
+11 SET RADEUC=0
WRITE !,$GET(RADARY(70.21,RAIENS,RAFLDS,"E"))
+12 WRITE !,$$REPEAT^XLFSTR("-",$LENGTH($GET(RADARY(70.21,RAIENS,RAFLDS,"E")))),!
+13 QUIT
End DoDot:3
+14 IF '$TEST
Begin DoDot:3
+15 SET RADEUC=RADEUC+1
+16 SET RAOPUT=$$TRAN(RAFLDS)_$GET(RADARY(70.21,RAIENS,RAFLDS,"E"))_$SELECT(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:"")
+17 IF RADEUC=1
WRITE $EXTRACT(RAOPUT,1,38)
IF RADEUC=2
WRITE ?39,$EXTRACT(RAOPUT,1,39)
+18 QUIT
End DoDot:3
+19 IF RADEUC'=2&($ORDER(RADARY(70.21,RAIENS,RAFLDS))="")
WRITE !
+20 IF RADEUC=2
WRITE !
IF RADEUC=2
SET RADEUC=0
+21 QUIT
End DoDot:2
IF $DATA(DIRUT)
QUIT
+22 QUIT
End DoDot:1
+23 QUIT
TRAN(X) ; Translate field name to a shorter length.
+1 IF X=2
QUIT "Dose (MD Override): "
IF X=3
QUIT "Prescriber: "
+2 IF X=4
QUIT "Activity Drawn: "
IF X=5
QUIT "Drawn: "
IF X=6
QUIT "Measured By: "
+3 IF X=7
QUIT "Dose Adm'd: "
IF X=8
QUIT "Date Adm'd: "
IF X=9
QUIT "Adm'd By: "
+4 IF X=10
QUIT "Witness: "
IF X=11
QUIT "Route: "
IF X=12
QUIT "Site: "
+5 IF X=12.5
QUIT "Site Text: "
IF X=13
QUIT "Lot #: "
IF X=14
QUIT "Volume: "
+6 IF X=15
QUIT "Form: "
VALDOS(RALOW,RAHI,X,RABACKTO,RAGOTO,RALASTAG,RAWARN) ;validate drawn/dose
+1 ; Called from [RA STATUS CHANGE] and [RA EXAM EDIT] input templates.
+2 ; Validate the value for either :
+3 ; ACTIVITY DRAWN (fld 4, DD: 70.21)
+4 ; DOSE (fld 7, DD: 70.21)
+5 ; If there are limits on the Dosage, validate.
+6 ; If validate fails, ask user if the invalid value is to be accepted.
+7 ; If yes, proceed.
+8 ; If no, re-ask DOSE.
+9 ; Input: RAHI = Upper limit on dosage
+10 ; RALOW = Lower limit on dosage
+11 ; X = Value user input
+12 ; RABACKTO = Previous Line tag to loop back to if need re-ask
+13 ; RAGOTO = Default linetag to proceed to if within range
+14 ; RALASTAG = Last linetag in this edit template if early out
+15 ; RAWARN = display/not the warning msg -- 0=no, 1=yes
+16 ;
+17 ; Output: RAY = linetag to proceed to after exiting this check
+18 ;
+19 NEW RAY,RAYN
SET RAY=""
IF X']""
SET RAY=RAGOTO
GOTO KVAL
+20 IF RALOW=""&(RAHI="")
SET RAY=RAGOTO
+21 IF RALOW]""&(RAHI="")&(X'<RALOW)
SET RAY=RAGOTO
+22 IF RALOW=""&(RAHI]"")&(X'>RAHI)
SET RAY=RAGOTO
+23 IF RALOW]""&(RAHI]"")&(X'<RALOW)&(X'>RAHI)
SET RAY=RAGOTO
+24 IF RAY=""
Begin DoDot:1
+25 FOR
Begin DoDot:2
+26 IF $ORDER(^RA(79,RAMDIV,"RWARN",0))
IF RAWARN
Begin DoDot:3
+27 NEW I
SET I=0
+28 FOR
SET I=$ORDER(^RA(79,RAMDIV,"RWARN",I))
IF I'>0
QUIT
WRITE !,$GET(^(I,0))
+29 QUIT
End DoDot:3
+30 IF '$TEST
IF RAWARN
Begin DoDot:3
+31 WRITE !,"This dose requires a written, dated and signed directive by"
+32 WRITE !,"a physician."
+33 QUIT
End DoDot:3
+34 WRITE !!?3,"Are you sure (Y/N)?: N//"
READ RAYN:DTIME
+35 IF '$TEST!(RAYN["^")
SET RAY=RALASTAG
QUIT
+36 SET RAYN=$SELECT(RAYN']"":"N",1:$$UP^XLFSTR($EXTRACT(RAYN)))
+37 SET RAY=$SELECT(RAYN="N":RABACKTO,RAYN="Y":RAGOTO,1:"")
+38 IF RAY=""
WRITE !!?3,"Enter 'Yes' if this value is acceptable, or 'No' if this field is to be",!?3,"re-edited.",$CHAR(7)
+39 QUIT
End DoDot:2
IF RAY]""
QUIT
+40 QUIT
End DoDot:1
KVAL KILL RABACKTO,RAGOTO,RALASTAG,RAWARN
+1 QUIT RAY
