source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDUTL2.m@ 1599

Last change on this file since 1599 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PSDUTL2 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 6 Sept 92
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3SAG ;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
7KAG ;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
11SAG1 ;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
15KAG1 ;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
19SAC ;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
24KAC ;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
29SAC1 ;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
34KAC1 ;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
39SAC2 ;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
44KAC2 ;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
Note: See TracBrowser for help on using the repository browser.