- 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 Mar 13, 2025@21:39:24 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 ;
