| [613] | 1 | PSDUTL2 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 6 Sept 92
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | SAG ;sets 'AG' xref in file 58.81 (field 11)
|
|---|
| 4 | S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
|
|---|
| 5 | S ^PSD(58.81,"AG",X,PSDNL,DA)="" K PSDNL
|
|---|
| 6 | Q
|
|---|
| 7 | KAG ;kills 'AG' x-ref in file 58.81 (field 11)
|
|---|
| 8 | S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
|
|---|
| 9 | K ^PSD(58.81,"AG",X,PSDNL,DA),PSDNL
|
|---|
| 10 | Q
|
|---|
| 11 | SAG1 ;set 'AG' x-ref on field 17 in 58.81
|
|---|
| 12 | S PSDOST=+$P(^PSD(58.81,DA,0),"^",12) I 'PSDOST K PSDOST Q
|
|---|
| 13 | S ^PSD(58.81,"AG",PSDOST,X,DA)="" K PSDOST
|
|---|
| 14 | Q
|
|---|
| 15 | KAG1 ;kill 'AG' x-ref on field 17 in 58.81
|
|---|
| 16 | S PSDOST=+$P(^PSD(58.81,DA,0),"^",12) I 'PSDOST K PSDOST Q
|
|---|
| 17 | K ^PSD(58.81,"AG",PSDOST,X,DA),PSDOST
|
|---|
| 18 | Q
|
|---|
| 19 | SAC ;set 'AC' x-ref on field 1 in 58.87
|
|---|
| 20 | S PSDNL=+$P(^PSD(58.87,DA,0),"^",13) I 'PSDNL K PSDNL Q
|
|---|
| 21 | S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12) I 'PSDTYPE K PSDTYPE Q
|
|---|
| 22 | S ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA)="" K PSDNL,PSDTYPE
|
|---|
| 23 | Q
|
|---|
| 24 | KAC ;kill 'AC' x-ref on field 1 in 58.87
|
|---|
| 25 | S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDTYPE=+$P(^(0),"^",12)
|
|---|
| 26 | I 'PSDNL!('PSDTYPE) K PSDNL,PSDTYPE Q
|
|---|
| 27 | K ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA),PSDNL,PSDTYPE
|
|---|
| 28 | Q
|
|---|
| 29 | SAC1 ;set 'AC' x-ref on field 11 in 58.87
|
|---|
| 30 | S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDDAT=+$P(^(0),"^",2)
|
|---|
| 31 | I 'PSDNL!('PSDDAT) K PSDNL,PSDDAT Q
|
|---|
| 32 | S ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA)="" K PSDNL,PSDDAT
|
|---|
| 33 | Q
|
|---|
| 34 | KAC1 ;kill 'AC' x-ref on field 11 in 58.87
|
|---|
| 35 | S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDDAT=+$P(^(0),"^",2)
|
|---|
| 36 | I 'PSDNL!('PSDDAT) K PSDNL,PSDDAT Q
|
|---|
| 37 | K ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA),PSDNL,PSDDAT
|
|---|
| 38 | Q
|
|---|
| 39 | SAC2 ;set 'AC' x-ref on field 12 in 58.87
|
|---|
| 40 | S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12),PSDDAT=+$P(^(0),"^",2)
|
|---|
| 41 | I 'PSDTYPE!('PSDDAT) K PSDTYPE,PSDDAT Q
|
|---|
| 42 | S ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA)="" K PSDTYPE,PSDDAT
|
|---|
| 43 | Q
|
|---|
| 44 | KAC2 ;kill 'AC' x-ref on field 12 in 58.87
|
|---|
| 45 | S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12),PSDDAT=+$P(^(0),"^",2)
|
|---|
| 46 | I 'PSDTYPE!('PSDDAT) K PSDTYPE,PSDDAT Q
|
|---|
| 47 | K ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA),PSDTYPE,PSDDAT
|
|---|
| 48 | Q
|
|---|
