source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDUTL5.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1PSDUTL5 ;BIR/JPW,LTL-Utility FM and X-Refs (cont'd) ; 14 Feb 95
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3SAEM ;set 'AEM' x-ref on field 3 in 58.81
4 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
5 I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
6 S ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA)="" K PSDNL,PSDDRU,PSDTYPE
7 Q
8KAEM ;kill 'AEM' x-ref on field 3 in 58.81
9 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
10 I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
11 K ^PSD(58.81,"AEM",X,PSDNL,PSDDRU,DA),PSDNL,PSDDRU,PSDTYPE
12 Q
13SAEM1 ;set 'AEM' x-ref on field 85 in 58.81
14 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDDRU=$P(^(0),"^",5)
15 I ('X)!('PSDATT)!('PSDDRU)!('PSDNL) K PSDATT,PSDDRU,PSDNL Q
16 S ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA)="" K PSDNL,PSDDRU,PSDATT
17 Q
18KAEM1 ;kill 'AEM' x-ref on field 85 in 58.81
19 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDDRU=$P(^(0),"^",5)
20 I ('PSDNL)!('PSDDRU)!('PSDATT) K PSDATT,PSDDRU,PSDNL Q
21 K ^PSD(58.81,"AEM",PSDATT,PSDNL,PSDDRU,DA),PSDATT,PSDDRU,PSDNL
22 Q
23SAEM2 ;set 'AEM' x-ref on field 2 in 58.81
24 S PSDATT=$P(^PSD(58.81,DA,0),"^",4),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
25 I ('PSDATT)!('PSDDRU)!('PSDTYPE) K PSDATT,PSDDRU,PSDTYPE Q
26 S ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA)="" K PSDATT,PSDDRU,PSDTYPE
27 Q
28KAEM2 ;kill 'AEM' x-ref on field 2 in 58.81
29 S PSDATT=$P(^PSD(58.81,DA,0),"^",4),PSDDRU=$P(^(0),"^",5),PSDTYPE=$P($G(^("CS")),"^",6)
30 I ('PSDATT)!('PSDDRU)!('PSDTYPE) K PSDATT,PSDDRU,PSDTYPE Q
31 K ^PSD(58.81,"AEM",PSDATT,X,PSDDRU,DA),PSDATT,PSDDRU,PSDTYPE
32 Q
33SAEM3 ;set 'AEM' x-ref on field 4 in 58.81
34 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDTYPE=$P($G(^("CS")),"^",6)
35 I 'PSDNL!('PSDATT)!('PSDTYPE) K PSDNL,PSDATT,PSDTYPE Q
36 S ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA)="" K PSDATT,PSDNL,PSDTYPE
37 Q
38KAEM3 ;kill 'AEM' x-ref on field 4 in 58.81
39 S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDATT=$P(^(0),"^",4),PSDTYPE=$P($G(^("CS")),"^",6)
40 I ('PSDNL)!('PSDATT)!('PSDTYPE) K PSDNL,PSDATT,PSDTYPE Q
41 K ^PSD(58.81,"AEM",PSDATT,PSDNL,X,DA),PSDNL,PSDATT,PSDTYPE
42 Q
Note: See TracBrowser for help on using the repository browser.