PSDUTL5 ;BIR/JPW,LTL-Utility FM and X-Refs (cont'd) ; 14 Feb 95 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97 SAEM ;set 'AEM' x-ref on field 3 in 58.81 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6) I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q S ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA)="" K PSDNL,PSDDRU,PSDTYPE Q KAEM ;kill 'AEM' x-ref on field 3 in 58.81 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6) I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q K ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA),PSDNL,PSDDRU,PSDTYPE Q SAEM1 ;set 'AEM' x-ref on field 85 in 58.81 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDDRU=$P(^(0),"^",5) I ('X)!('PSDATT)!('PSDDRU)!('PSDNL) K PSDATT,PSDDRU,PSDNL Q S ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA)="" K PSDNL,PSDDRU,PSDATT Q KAEM1 ;kill 'AEM' x-ref on field 85 in 58.81 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDDRU=$P(^(0),"^",5) I ('PSDNL)!('PSDDRU)!('PSDATT) K PSDATT,PSDDRU,PSDNL Q K ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA),PSDATT,PSDDRU,PSDNL Q SAEM2 ;set 'AEM' x-ref on field 2 in 58.81 S PSDATT=$P(^PSD(58.81,DA,0),"^",4),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6) I ('PSDATT)!('PSDDRU)!('PSDTYPE) K PSDATT,PSDDRU,PSDTYPE Q S ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA)="" K PSDATT,PSDDRU,PSDTYPE Q KAEM2 ;kill 'AEM' x-ref on field 2 in 58.81 S PSDATT=$P(^PSD(58.81,DA,0),"^",4),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6) I ('PSDATT)!('PSDDRU)!('PSDTYPE) K PSDATT,PSDDRU,PSDTYPE Q K ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA),PSDATT,PSDDRU,PSDTYPE Q SAEM3 ;set 'AEM' x-ref on field 4 in 58.81 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDTYPE=$P($G(^("CS")),"^",6) I 'PSDNL!('PSDATT)!('PSDTYPE) K PSDNL,PSDATT,PSDTYPE Q S ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA)="" K PSDATT,PSDNL,PSDTYPE Q KAEM3 ;kill 'AEM' x-ref on field 4 in 58.81 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDTYPE=$P($G(^("CS")),"^",6) I ('PSDNL)!('PSDATT)!('PSDTYPE) K PSDNL,PSDATT,PSDTYPE Q K ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA),PSDNL,PSDATT,PSDTYPE Q