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
|
---|