| 1 | RADD4 ;HISC/GJC-Radiology Utility Routine ;11/25/97  12:40 | 
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998 | 
|---|
| 3 | ; | 
|---|
| 4 | DCHK() ; Check if drug if DRUG is active AND a Radiopharmaceutical. | 
|---|
| 5 | ; 'RASTAT=1' if active AND RADG condition met | 
|---|
| 6 | ; 'RASTAT=0' if inactive OR RADG condition not met | 
|---|
| 7 | ; VERSION 5.0 called from ^DD(70.21,.01,12.1) & DCHK^RADD1 | 
|---|
| 8 | ; 'Y'    is the IEN for the Drug file | 
|---|
| 9 | ; 'RADT' is the cutoff date for drugs in the drug file | 
|---|
| 10 | ; 'RADG':$S(RADG="R":Radiopharm,"P":non-Radioharm,1:non-Radiopharm) | 
|---|
| 11 | N RACLASS,RADRUG,RASTAT S:RADG']"" RADG="P" | 
|---|
| 12 | S RADRUG(2)=$P($G(^PSDRUG(Y,0)),"^",2) | 
|---|
| 13 | S RACLASS="^DX200^DX201^DX202^" | 
|---|
| 14 | S RASTAT=$$DCHK1()  ; is it active '1' yes, '0' no. | 
|---|
| 15 | I RASTAT D  ; is active check class | 
|---|
| 16 | . S:RADG="R"&(RACLASS'[("^"_RADRUG(2)_"^")) RASTAT=0 | 
|---|
| 17 | . S:RADG="P"&(RACLASS[("^"_RADRUG(2)_"^")) RASTAT=0 | 
|---|
| 18 | . Q | 
|---|
| 19 | Q RASTAT | 
|---|
| 20 | ; | 
|---|
| 21 | DCHK1() ; Check if drug if DRUG is an active pharmaceutical | 
|---|
| 22 | ; '1' if active AND Pharm, '0' if inactive | 
|---|
| 23 | ; VERSION 5.0 called from DCHK above | 
|---|
| 24 | ; 'Y'    is the IEN for the Drug file | 
|---|
| 25 | ; 'RADT'  is the cutoff date for drugs in the drug file | 
|---|
| 26 | ; VERSION 5.0 | 
|---|
| 27 | N RAINACT | 
|---|
| 28 | S RAINACT=+$G(^PSDRUG(Y,"I")) | 
|---|
| 29 | Q:'RAINACT 1 ; not inactive | 
|---|
| 30 | I RAINACT,(RAINACT'>RADT) Q 0 ; not active | 
|---|
| 31 | Q 1 ; active | 
|---|
| 32 | ; | 
|---|
| 33 | VALADM() ;edit validation | 
|---|
| 34 | ;Used to validate/screen radiopharm dosage administrator, | 
|---|
| 35 | ;   radiopharm prescribing phys, person who measured radiopharm dose, | 
|---|
| 36 | ;---------------------------------------------------------------------- | 
|---|
| 37 | ; RAD0  : IEN of entry in question for NUC MED EXAM DATA (70.2) file | 
|---|
| 38 | ; Y     : Pointer to the New Person file | 
|---|
| 39 | ; RADT  : Xam Date; if not passed, calculate exam date from file 70.2 | 
|---|
| 40 | ; RAUTH : 1 - only staff/resid, must be auth'zd to write med orders | 
|---|
| 41 | ;       : 0 - staff/resid & tech's | 
|---|
| 42 | ;---------------------------------------------------------------------- | 
|---|
| 43 | ; Output: '1' authorized to write med orders, else '0' | 
|---|
| 44 | ;---------------------------------------------------------------------- | 
|---|
| 45 | N RAPS S RAPS=$G(^VA(200,Y,"PS")) | 
|---|
| 46 | ; $P(RAPS,"^")   - authorized to write med orders '1': Yes | 
|---|
| 47 | ; $P(RAPS,"^",4) - person CAN'T write med orders after this date(if any) | 
|---|
| 48 | S:$G(RADT)="" RADT=$P($G(^RADPTN(RAD0,0)),"^",2) | 
|---|
| 49 | I 'RAUTH,($D(^VA(200,"ARC","R",Y))!$D(^VA(200,"ARC","S",Y))!$D(^VA(200,"ARC","T",Y))) Q 1 | 
|---|
| 50 | 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 | 
|---|
| 51 | Q 0 | 
|---|
| 52 | ; | 
|---|
| 53 | VOL() ; Validate the format of the value input for volume. | 
|---|
| 54 | ; RAX must be a number followed by a space then text -or- | 
|---|
| 55 | ; a number followed by text | 
|---|
| 56 | ; Input Variable : 'RAX'- user's input | 
|---|
| 57 | ; Output Variable: null if 'RAX' erroneous, formatted version of 'RAX' | 
|---|
| 58 | Q:(RAX'?0.5N0.1"."0.2N1" "1.30A)&(RAX'?0.5N0.1"."0.2N1.30A) "" | 
|---|
| 59 | N RAX1,RAY S RAX1=+RAX,RAY=$P(RAX,RAX1,2) Q:RAX1'>0 "" | 
|---|
| 60 | S RAY=$S($F(RAY," ")>0:$E(RAY,$F(RAY," "),9999),1:RAY) | 
|---|
| 61 | S RAY=$S($F(RAY,".")>0:$E(RAY,$F(RAY,"."),9999),1:RAY) | 
|---|
| 62 | S RAY=$$STRIP^XLFSTR(RAY,"0") | 
|---|
| 63 | S RAY=$$LOW^XLFSTR($E(RAY,1)) | 
|---|
| 64 | I RAY'="c",(RAY'="m") Q "" | 
|---|
| 65 | Q RAX1_" "_RAY | 
|---|