- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDUTL5 2189 printed Feb 18, 2025@23:15:46 Page 2
- 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