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