1 | PSDUTL5 ;BIR/JPW,LTL-Utility FM and X-Refs (cont'd) ; 14 Feb 95
|
---|
2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
---|
3 | SAEM ;set 'AEM' x-ref on field 3 in 58.81
|
---|
4 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
|
---|
5 | I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
|
---|
6 | S ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA)="" K PSDNL,PSDDRU,PSDTYPE
|
---|
7 | Q
|
---|
8 | KAEM ;kill 'AEM' x-ref on field 3 in 58.81
|
---|
9 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
|
---|
10 | I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
|
---|
11 | K ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA),PSDNL,PSDDRU,PSDTYPE
|
---|
12 | Q
|
---|
13 | SAEM1 ;set 'AEM' x-ref on field 85 in 58.81
|
---|
14 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDDRU=$P(^(0),"^",5)
|
---|
15 | I ('X)!('PSDATT)!('PSDDRU)!('PSDNL) K PSDATT,PSDDRU,PSDNL Q
|
---|
16 | S ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA)="" K PSDNL,PSDDRU,PSDATT
|
---|
17 | Q
|
---|
18 | KAEM1 ;kill 'AEM' x-ref on field 85 in 58.81
|
---|
19 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDDRU=$P(^(0),"^",5)
|
---|
20 | I ('PSDNL)!('PSDDRU)!('PSDATT) K PSDATT,PSDDRU,PSDNL Q
|
---|
21 | K ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA),PSDATT,PSDDRU,PSDNL
|
---|
22 | Q
|
---|
23 | SAEM2 ;set 'AEM' x-ref on field 2 in 58.81
|
---|
24 | S PSDATT=$P(^PSD(58.81,DA,0),"^",4),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
|
---|
25 | I ('PSDATT)!('PSDDRU)!('PSDTYPE) K PSDATT,PSDDRU,PSDTYPE Q
|
---|
26 | S ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA)="" K PSDATT,PSDDRU,PSDTYPE
|
---|
27 | Q
|
---|
28 | KAEM2 ;kill 'AEM' x-ref on field 2 in 58.81
|
---|
29 | S PSDATT=$P(^PSD(58.81,DA,0),"^",4),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
|
---|
30 | I ('PSDATT)!('PSDDRU)!('PSDTYPE) K PSDATT,PSDDRU,PSDTYPE Q
|
---|
31 | K ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA),PSDATT,PSDDRU,PSDTYPE
|
---|
32 | Q
|
---|
33 | SAEM3 ;set 'AEM' x-ref on field 4 in 58.81
|
---|
34 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDTYPE=$P($G(^("CS")),"^",6)
|
---|
35 | I 'PSDNL!('PSDATT)!('PSDTYPE) K PSDNL,PSDATT,PSDTYPE Q
|
---|
36 | S ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA)="" K PSDATT,PSDNL,PSDTYPE
|
---|
37 | Q
|
---|
38 | KAEM3 ;kill 'AEM' x-ref on field 4 in 58.81
|
---|
39 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDTYPE=$P($G(^("CS")),"^",6)
|
---|
40 | I ('PSDNL)!('PSDATT)!('PSDTYPE) K PSDNL,PSDATT,PSDTYPE Q
|
---|
41 | K ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA),PSDNL,PSDATT,PSDTYPE
|
---|
42 | Q
|
---|