RADD4.m

RADD4 ;HISC/GJC-Radiology Utility Routine ;11/25/97  12:40

 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8

 ;

 ;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

RADD4     ;HISC/GJC-Radiology Utility Routine ;11/25/97  12:40

 +1       ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8

 +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