- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRASTREQN 7795 printed Feb 19, 2025@00:06:12 Page 2
- 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
