RADD4.m

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 ---RADD4   2365     printed  Apr 09, 2024@21:35:28                                                                                                                                                                                                       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       ;