| 1 | PSDUTL3 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 18 Jan 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | SAC ;sets 'AC' x-ref on field 10 in file 58.86
|
|---|
| 4 | S PSDDRU=+$P(^PSD(58.86,DA,0),"^",2),PSDNL=+$P(^(0),"^",7) I 'PSDDRU!('PSDNL) K PSDDDU,PSDNL Q
|
|---|
| 5 | S ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA)="" K PSDDRU,PSDNL
|
|---|
| 6 | Q
|
|---|
| 7 | KAC ;kills 'AC' x-ref on field 10 in file 58.86
|
|---|
| 8 | S PSDDRU=+$P(^PSD(58.86,DA,0),"^",2),PSDNL=+$P(^(0),"^",7) I 'PSDDRU!('PSDNL) K PSDDRU,PSDNL Q
|
|---|
| 9 | K ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
|
|---|
| 10 | Q
|
|---|
| 11 | SAC1 ;sets 'AC' x-ref on field 1 in file 58.86
|
|---|
| 12 | S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
|
|---|
| 13 | S ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA)="" K PSDDAT,PSDNL
|
|---|
| 14 | Q
|
|---|
| 15 | KAC1 ;kills 'AC' x-ref on field 1 in file 58.86
|
|---|
| 16 | S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
|
|---|
| 17 | K ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
|
|---|
| 18 | Q
|
|---|
| 19 | SAC2 ;sets 'AC' x-ref on field 6 in file 58.86
|
|---|
| 20 | S PSDDRU=$P(^PSD(58.86,DA,0),"^",2),PSDDAT=$P(^(0),"^",11) I 'PSDDRU!('PSDDAT) K PSDDRU,PSDDAT Q
|
|---|
| 21 | S ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA)="" K PSDDAT,PSDDRU
|
|---|
| 22 | Q
|
|---|
| 23 | KAC2 ;kills 'AC' x-ref on field 6 in file 58.86
|
|---|
| 24 | S PSDDRU=$P(^PSD(58.86,DA,0),"^",2),PSDDAT=$P(^(0),"^",11) I 'PSDDRU!('PSDDAT) K PSDDRU,PSDDAT Q
|
|---|
| 25 | K ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
|
|---|
| 26 | Q
|
|---|
| 27 | SAD ;sets 'AD' x-ref on field 10 in file 58.86
|
|---|
| 28 | S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDNL=+$P(^(0),"^",7) I PSDDRU']""!('PSDNL) K PSDDRU,PSDNL Q
|
|---|
| 29 | S ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA)="" K PSDDRU,PSDNL
|
|---|
| 30 | Q
|
|---|
| 31 | KAD ;kills 'AD' x-ref on field 10 in file 58.86
|
|---|
| 32 | S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDNL=+$P(^(0),"^",7) I PSDDRU']""!('PSDNL) K PSDDRU,PSDNL Q
|
|---|
| 33 | K ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
|
|---|
| 34 | Q
|
|---|
| 35 | SAD1 ;sets 'AD' x-ref on field 13 in file 58.86
|
|---|
| 36 | S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
|
|---|
| 37 | S ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA)="" K PSDDAT,PSDNL
|
|---|
| 38 | Q
|
|---|
| 39 | KAD1 ;kills 'AD' x-ref on field 13 in file 58.86
|
|---|
| 40 | S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
|
|---|
| 41 | K ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
|
|---|
| 42 | Q
|
|---|
| 43 | SAD2 ;sets 'AD' x-ref on field 6 in file 58.86
|
|---|
| 44 | S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDDAT=$P(^(0),"^",11) I PSDDRU']""!('PSDDAT) K PSDDRU,PSDDAT Q
|
|---|
| 45 | S ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA)="" K PSDDAT,PSDDRU
|
|---|
| 46 | Q
|
|---|
| 47 | KAD2 ;kills 'AD' x-ref on field 6 in file 58.86
|
|---|
| 48 | S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDDAT=$P(^(0),"^",11) I PSDDRU']""!('PSDDAT) K PSDDRU,PSDDAT Q
|
|---|
| 49 | K ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
|
|---|
| 50 | Q
|
|---|
| 51 | SACT7 ;set 'ACT' x-ref on field 37 in 58.81
|
|---|
| 52 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=4
|
|---|
| 53 | I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
|
|---|
| 54 | S ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA)="" K PSDNL,PSDDRU,PSDTYPE
|
|---|
| 55 | Q
|
|---|
| 56 | KACT7 ;kill 'ACT' x-ref on field 37 in 58.81
|
|---|
| 57 | S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=4
|
|---|
| 58 | I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
|
|---|
| 59 | K ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA),PSDNL,PSDDRU,PSDTYPE
|
|---|
| 60 | Q
|
|---|
