Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSDUTL3

PSDUTL3.m

Go to the documentation of this file.
  1. PSDUTL3 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 18 Jan 94
  1. ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
  1. SAC ;sets 'AC' x-ref on field 10 in file 58.86
  1. S PSDDRU=+$P(^PSD(58.86,DA,0),"^",2),PSDNL=+$P(^(0),"^",7) I 'PSDDRU!('PSDNL) K PSDDDU,PSDNL Q
  1. S ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA)="" K PSDDRU,PSDNL
  1. Q
  1. KAC ;kills 'AC' x-ref on field 10 in file 58.86
  1. S PSDDRU=+$P(^PSD(58.86,DA,0),"^",2),PSDNL=+$P(^(0),"^",7) I 'PSDDRU!('PSDNL) K PSDDRU,PSDNL Q
  1. K ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
  1. Q
  1. SAC1 ;sets 'AC' x-ref on field 1 in file 58.86
  1. S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
  1. S ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA)="" K PSDDAT,PSDNL
  1. Q
  1. KAC1 ;kills 'AC' x-ref on field 1 in file 58.86
  1. S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
  1. K ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
  1. Q
  1. SAC2 ;sets 'AC' x-ref on field 6 in file 58.86
  1. S PSDDRU=$P(^PSD(58.86,DA,0),"^",2),PSDDAT=$P(^(0),"^",11) I 'PSDDRU!('PSDDAT) K PSDDRU,PSDDAT Q
  1. S ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA)="" K PSDDAT,PSDDRU
  1. Q
  1. KAC2 ;kills 'AC' x-ref on field 6 in file 58.86
  1. S PSDDRU=$P(^PSD(58.86,DA,0),"^",2),PSDDAT=$P(^(0),"^",11) I 'PSDDRU!('PSDDAT) K PSDDRU,PSDDAT Q
  1. K ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
  1. Q
  1. SAD ;sets 'AD' x-ref on field 10 in file 58.86
  1. S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDNL=+$P(^(0),"^",7) I PSDDRU']""!('PSDNL) K PSDDRU,PSDNL Q
  1. S ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA)="" K PSDDRU,PSDNL
  1. Q
  1. KAD ;kills 'AD' x-ref on field 10 in file 58.86
  1. S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDNL=+$P(^(0),"^",7) I PSDDRU']""!('PSDNL) K PSDDRU,PSDNL Q
  1. K ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
  1. Q
  1. SAD1 ;sets 'AD' x-ref on field 13 in file 58.86
  1. S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
  1. S ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA)="" K PSDDAT,PSDNL
  1. Q
  1. KAD1 ;kills 'AD' x-ref on field 13 in file 58.86
  1. S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
  1. K ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
  1. Q
  1. SAD2 ;sets 'AD' x-ref on field 6 in file 58.86
  1. S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDDAT=$P(^(0),"^",11) I PSDDRU']""!('PSDDAT) K PSDDRU,PSDDAT Q
  1. S ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA)="" K PSDDAT,PSDDRU
  1. Q
  1. KAD2 ;kills 'AD' x-ref on field 6 in file 58.86
  1. S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDDAT=$P(^(0),"^",11) I PSDDRU']""!('PSDDAT) K PSDDRU,PSDDAT Q
  1. K ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
  1. Q
  1. SACT7 ;set 'ACT' x-ref on field 37 in 58.81
  1. S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=4
  1. I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
  1. S ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA)="" K PSDNL,PSDDRU,PSDTYPE
  1. Q
  1. KACT7 ;kill 'ACT' x-ref on field 37 in 58.81
  1. S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=4
  1. I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
  1. K ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA),PSDNL,PSDDRU,PSDTYPE
  1. Q