RADD4 ;HISC/GJC-Radiology Utility Routine ; Jan 31, 2023@13:22:32
;;5.0;Radiology/Nuclear Medicine;**65,198**;Mar 16, 1998;Build 1
;
;supported IA #10104 reference to STRIP^XLFSTR and LOW^XLFSTR
;
VALADM() ;edit validation
;Used to validate/screen radiopharm dosage administrator,
; radiopharm prescribing phys, person who measured radiopharm dose,
;----------------------------------------------------------------------
; RAD0 : IEN of entry in question for NUC MED EXAM DATA (70.2) file
; Y : Pointer to the New Person file
; RADT : Xam Date; if not passed, calculate exam date from file 70.2
; RAUTH : 1 - only staff/resid, must be auth'zd to write med orders
; : 0 - staff/resid & tech's
;----------------------------------------------------------------------
; Output: '1' authorized to write med orders, else '0'
;----------------------------------------------------------------------
N RAPS S RAPS=$G(^VA(200,Y,"PS"))
; $P(RAPS,"^") - authorized to write med orders '1': Yes
; $P(RAPS,"^",4) - person CAN'T write med orders after this date(if any)
S:$G(RADT)="" RADT=$P($G(^RADPTN(RAD0,0)),"^",2)
I 'RAUTH,($D(^VA(200,"ARC","R",Y))!$D(^VA(200,"ARC","S",Y))!$D(^VA(200,"ARC","T",Y))) Q 1
I RAUTH,($D(^VA(200,"ARC","R",Y))!$D(^VA(200,"ARC","S",Y))),(+$P(RAPS,"^")),($S('$P(RAPS,"^",4):1,$P(RAPS,"^",4)'<RADT:1,1:0)) Q 1
Q 0
;
VOL() ; Validate the format of the value input for volume.
; RAX must be a number followed by a space then text -or-
; a number followed by text
; Input Variable : 'RAX'- user's input
; Output Variable: null if 'RAX' erroneous, formatted version of 'RAX'
Q:(RAX'?0.5N0.1"."0.2N1" "1.30A)&(RAX'?0.5N0.1"."0.2N1.30A) ""
N RAX1,RAY S RAX1=+RAX,RAY=$P(RAX,RAX1,2) Q:RAX1'>0 ""
S RAY=$S($F(RAY," ")>0:$E(RAY,$F(RAY," "),9999),1:RAY)
S RAY=$S($F(RAY,".")>0:$E(RAY,$F(RAY,"."),9999),1:RAY)
S RAY=$$STRIP^XLFSTR(RAY,"0")
S RAY=$$LOW^XLFSTR($E(RAY,1))
I RAY'="c",(RAY'="m") Q ""
Q RAX1_" "_RAY
;
DD7012(RAY) ;radiology technologist check
;passes only if tech is active ("RA" node)
;passes only if tech is classified "T" ("RAC" node)
;Input: RAY = IEN (when +'d) of technologist from NEW PERSON file.
N RAINACTIV S RAINACTIV=$P($G(^VA(200,+RAY,"RA")),U,3)
I RAINACTIV>0,(RAINACTIV'>DT) Q 0
Q:($D(^VA(200,"ARC","T",+RAY))\10=0) 0
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRADD4 2365 printed Oct 16, 2024@18:35:15 Page 2
RADD4 ;HISC/GJC-Radiology Utility Routine ; Jan 31, 2023@13:22:32
+1 ;;5.0;Radiology/Nuclear Medicine;**65,198**;Mar 16, 1998;Build 1
+2 ;
+3 ;supported IA #10104 reference to STRIP^XLFSTR and LOW^XLFSTR
+4 ;
VALADM() ;edit validation
+1 ;Used to validate/screen radiopharm dosage administrator,
+2 ; radiopharm prescribing phys, person who measured radiopharm dose,
+3 ;----------------------------------------------------------------------
+4 ; RAD0 : IEN of entry in question for NUC MED EXAM DATA (70.2) file
+5 ; Y : Pointer to the New Person file
+6 ; RADT : Xam Date; if not passed, calculate exam date from file 70.2
+7 ; RAUTH : 1 - only staff/resid, must be auth'zd to write med orders
+8 ; : 0 - staff/resid & tech's
+9 ;----------------------------------------------------------------------
+10 ; Output: '1' authorized to write med orders, else '0'
+11 ;----------------------------------------------------------------------
+12 NEW RAPS
SET RAPS=$GET(^VA(200,Y,"PS"))
+13 ; $P(RAPS,"^") - authorized to write med orders '1': Yes
+14 ; $P(RAPS,"^",4) - person CAN'T write med orders after this date(if any)
+15 if $GET(RADT)=""
SET RADT=$PIECE($GET(^RADPTN(RAD0,0)),"^",2)
+16 IF 'RAUTH
IF ($DATA(^VA(200,"ARC","R",Y))!$DATA(^VA(200,"ARC","S",Y))!$DATA(^VA(200,"ARC","T",Y)))
QUIT 1
+17 IF RAUTH
IF ($DATA(^VA(200,"ARC","R",Y))!$DATA(^VA(200,"ARC","S",Y)))
IF (+$PIECE(RAPS,"^"))
IF ($SELECT('$PIECE(RAPS,"^",4):1,$PIECE(RAPS,"^",4)'<RADT:1,1:0))
QUIT 1
+18 QUIT 0
+19 ;
VOL() ; Validate the format of the value input for volume.
+1 ; RAX must be a number followed by a space then text -or-
+2 ; a number followed by text
+3 ; Input Variable : 'RAX'- user's input
+4 ; Output Variable: null if 'RAX' erroneous, formatted version of 'RAX'
+5 if (RAX'?0.5N0.1"."0.2N1" "1.30A)&(RAX'?0.5N0.1"."0.2N1.30A)
QUIT ""
+6 NEW RAX1,RAY
SET RAX1=+RAX
SET RAY=$PIECE(RAX,RAX1,2)
if RAX1'>0
QUIT ""
+7 SET RAY=$SELECT($FIND(RAY," ")>0:$EXTRACT(RAY,$FIND(RAY," "),9999),1:RAY)
+8 SET RAY=$SELECT($FIND(RAY,".")>0:$EXTRACT(RAY,$FIND(RAY,"."),9999),1:RAY)
+9 SET RAY=$$STRIP^XLFSTR(RAY,"0")
+10 SET RAY=$$LOW^XLFSTR($EXTRACT(RAY,1))
+11 IF RAY'="c"
IF (RAY'="m")
QUIT ""
+12 QUIT RAX1_" "_RAY
+13 ;
DD7012(RAY) ;radiology technologist check
+1 ;passes only if tech is active ("RA" node)
+2 ;passes only if tech is classified "T" ("RAC" node)
+3 ;Input: RAY = IEN (when +'d) of technologist from NEW PERSON file.
+4 NEW RAINACTIV
SET RAINACTIV=$PIECE($GET(^VA(200,+RAY,"RA")),U,3)
+5 IF RAINACTIV>0
IF (RAINACTIV'>DT)
QUIT 0
+6 if ($DATA(^VA(200,"ARC","T",+RAY))\10=0)
QUIT 0
+7 QUIT 1
+8 ;
