PSDUTL5.m

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

PSDUTL5   ;BIR/JPW,LTL-Utility FM and X-Refs (cont'd) ; 14 Feb 95

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

SAEM      ;set 'AEM' x-ref on field 3 in 58.81

 +1        SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)

           SET PSDDRU=$PIECE(^(0),"^",5)

           SET PSDTYPE=$PIECE($GET(^("CS")),"^",6)

 +2        IF ('PSDNL)!('PSDDRU)!('PSDTYPE)

               KILL PSDNL,PSDDRU,PSDTYPE

               QUIT 

 +3        SET ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA)=""

           KILL PSDNL,PSDDRU,PSDTYPE

 +4        QUIT 

KAEM      ;kill 'AEM' x-ref on field 3 in 58.81

 +1        SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)

           SET PSDDRU=$PIECE(^(0),"^",5)

           SET PSDTYPE=$PIECE($GET(^("CS")),"^",6)

 +2        IF ('PSDNL)!('PSDDRU)!('PSDTYPE)

               KILL PSDNL,PSDDRU,PSDTYPE

               QUIT 

 +3        KILL ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA),PSDNL,PSDDRU,PSDTYPE

 +4        QUIT 

SAEM1     ;set 'AEM' x-ref on field 85 in 58.81

 +1        SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)

           SET PSDATT=$PIECE(^(0),"^",4)

           SET PSDDRU=$PIECE(^(0),"^",5)

 +2        IF ('X)!('PSDATT)!('PSDDRU)!('PSDNL)

               KILL PSDATT,PSDDRU,PSDNL

               QUIT 

 +3        SET ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA)=""

           KILL PSDNL,PSDDRU,PSDATT

 +4        QUIT 

KAEM1     ;kill 'AEM' x-ref on field 85 in 58.81

 +1        SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)

           SET PSDATT=$PIECE(^(0),"^",4)

           SET PSDDRU=$PIECE(^(0),"^",5)

 +2        IF ('PSDNL)!('PSDDRU)!('PSDATT)

               KILL PSDATT,PSDDRU,PSDNL

               QUIT 

 +3        KILL ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA),PSDATT,PSDDRU,PSDNL

 +4        QUIT 

SAEM2     ;set 'AEM' x-ref on field 2 in 58.81

 +1        SET PSDATT=$PIECE(^PSD(58.81,DA,0),"^",4)

           SET PSDDRU=$PIECE(^(0),"^",5)

           SET PSDTYPE=$PIECE($GET(^("CS")),"^",6)

 +2        IF ('PSDATT)!('PSDDRU)!('PSDTYPE)

               KILL PSDATT,PSDDRU,PSDTYPE

               QUIT 

 +3        SET ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA)=""

           KILL PSDATT,PSDDRU,PSDTYPE

 +4        QUIT 

KAEM2     ;kill 'AEM' x-ref on field 2 in 58.81

 +1        SET PSDATT=$PIECE(^PSD(58.81,DA,0),"^",4)

           SET PSDDRU=$PIECE(^(0),"^",5)

           SET PSDTYPE=$PIECE($GET(^("CS")),"^",6)

 +2        IF ('PSDATT)!('PSDDRU)!('PSDTYPE)

               KILL PSDATT,PSDDRU,PSDTYPE

               QUIT 

 +3        KILL ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA),PSDATT,PSDDRU,PSDTYPE

 +4        QUIT 

SAEM3     ;set 'AEM' x-ref on field 4 in 58.81

 +1        SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)

           SET PSDATT=$PIECE(^(0),"^",4)

           SET PSDTYPE=$PIECE($GET(^("CS")),"^",6)

 +2        IF 'PSDNL!('PSDATT)!('PSDTYPE)

               KILL PSDNL,PSDATT,PSDTYPE

               QUIT 

 +3        SET ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA)=""

           KILL PSDATT,PSDNL,PSDTYPE

 +4        QUIT 

KAEM3     ;kill 'AEM' x-ref on field 4 in 58.81

 +1        SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)

           SET PSDATT=$PIECE(^(0),"^",4)

           SET PSDTYPE=$PIECE($GET(^("CS")),"^",6)

 +2        IF ('PSDNL)!('PSDATT)!('PSDTYPE)

               KILL PSDNL,PSDATT,PSDTYPE

               QUIT 

 +3        KILL ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA),PSDNL,PSDATT,PSDTYPE

 +4        QUIT