source: FOIAVistA/tag/r/CONTROLLED_SUBSTANCES-PSD/PSDUTL4.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 1.8 KB
Line 
1PSDUTL4 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 22 Jun 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3SAD ;sets 'AD' x-ref on field 2 in file 58.89
4 S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
5 S ^PSD(58.89,"AD",X,PSDNL,DA)="" K PSDNL
6 Q
7KAD ;kills 'AD' x-ref on field 2 in file 58.89
8 S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
9 K ^PSD(58.89,"AD",X,PSDNL,DA),PSDNL
10 Q
11SAD1 ;sets 'AD' x-ref on field 6 in file 58.89
12 S PSDDAT=+$P(^PSD(58.89,DA,0),"^",3) I 'PSDDAT K PSDDAT Q
13 S ^PSD(58.89,"AD",PSDDAT,X,DA)="" K PSDDAT
14 Q
15KAD1 ;kills 'AD' x-ref on field 6 in file 58.89
16 S PSDDAT=+$P(^PSD(58.89,DA,0),"^",3) I 'PSDDAT K PSDDAT Q
17 K ^PSD(58.89,"AD",PSDDAT,X,DA),PSDDAT
18 Q
19SAE ;sets 'AE' x-ref on field 4 in file 58.89
20 S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
21 S ^PSD(58.89,"AE",X,PSDNL,DA)="" K PSDNL
22 Q
23KAE ;kills 'AE' x-ref on field 4 in file 58.89
24 S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
25 K ^PSD(58.89,"AE",X,PSDNL,DA),PSDNL
26 Q
27SAE1 ;sets 'AE' x-ref on field 6 in file 58.89
28 S PSDDAT=+$P(^PSD(58.89,DA,0),"^",5) I 'PSDDAT K PSDDAT Q
29 S ^PSD(58.89,"AE",PSDDAT,X,DA)="" K PSDDAT
30 Q
31KAE1 ;kills 'AE' x-ref on field 6 in file 58.89
32 S PSDDAT=+$P(^PSD(58.89,DA,0),"^",5) I 'PSDDAT K PSDDAT Q
33 K ^PSD(58.89,"AE",PSDDAT,X,DA),PSDDAT
34 Q
35SAK ;sets 'AK' x-ref on field 21 in file 58.81
36 S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
37 S ^PSD(58.81,"AK",X,PSDNL,DA)="" K PSDNL
38 Q
39KAK ;kills 'AK' x-ref on field 21 in file 58.81
40 S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
41 K ^PSD(58.81,"AK",X,PSDNL,DA),PSDNL
42 Q
43SAK1 ;sets 'AK' x-ref on field 17 in file 58.81
44 S PSDDAT=+$P($G(^PSD(58.81,DA,1)),"^",4) I 'PSDDAT K PSDDAT Q
45 S ^PSD(58.81,"AK",PSDDAT,X,DA)="" K PSDDAT
46 Q
47KAK1 ;kills 'AK' x-ref on field 17 in file 58.81
48 S PSDDAT=+$P($G(^PSD(58.81,DA,1)),"^",4) I 'PSDDAT K PSDDAT Q
49 K ^PSD(58.81,"AK",PSDDAT,X,DA),PSDDAT
50 Q
Note: See TracBrowser for help on using the repository browser.