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

PSDUTL2.m

Go to the documentation of this file.
  1. PSDUTL2 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 6 Sept 92
  1. ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
  1. SAG ;sets 'AG' xref in file 58.81 (field 11)
  1. S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
  1. S ^PSD(58.81,"AG",X,PSDNL,DA)="" K PSDNL
  1. Q
  1. KAG ;kills 'AG' x-ref in file 58.81 (field 11)
  1. S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
  1. K ^PSD(58.81,"AG",X,PSDNL,DA),PSDNL
  1. Q
  1. SAG1 ;set 'AG' x-ref on field 17 in 58.81
  1. S PSDOST=+$P(^PSD(58.81,DA,0),"^",12) I 'PSDOST K PSDOST Q
  1. S ^PSD(58.81,"AG",PSDOST,X,DA)="" K PSDOST
  1. Q
  1. KAG1 ;kill 'AG' x-ref on field 17 in 58.81
  1. S PSDOST=+$P(^PSD(58.81,DA,0),"^",12) I 'PSDOST K PSDOST Q
  1. K ^PSD(58.81,"AG",PSDOST,X,DA),PSDOST
  1. Q
  1. SAC ;set 'AC' x-ref on field 1 in 58.87
  1. S PSDNL=+$P(^PSD(58.87,DA,0),"^",13) I 'PSDNL K PSDNL Q
  1. S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12) I 'PSDTYPE K PSDTYPE Q
  1. S ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA)="" K PSDNL,PSDTYPE
  1. Q
  1. KAC ;kill 'AC' x-ref on field 1 in 58.87
  1. S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDTYPE=+$P(^(0),"^",12)
  1. I 'PSDNL!('PSDTYPE) K PSDNL,PSDTYPE Q
  1. K ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA),PSDNL,PSDTYPE
  1. Q
  1. SAC1 ;set 'AC' x-ref on field 11 in 58.87
  1. S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDDAT=+$P(^(0),"^",2)
  1. I 'PSDNL!('PSDDAT) K PSDNL,PSDDAT Q
  1. S ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA)="" K PSDNL,PSDDAT
  1. Q
  1. KAC1 ;kill 'AC' x-ref on field 11 in 58.87
  1. S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDDAT=+$P(^(0),"^",2)
  1. I 'PSDNL!('PSDDAT) K PSDNL,PSDDAT Q
  1. K ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA),PSDNL,PSDDAT
  1. Q
  1. SAC2 ;set 'AC' x-ref on field 12 in 58.87
  1. S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12),PSDDAT=+$P(^(0),"^",2)
  1. I 'PSDTYPE!('PSDDAT) K PSDTYPE,PSDDAT Q
  1. S ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA)="" K PSDTYPE,PSDDAT
  1. Q
  1. KAC2 ;kill 'AC' x-ref on field 12 in 58.87
  1. S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12),PSDDAT=+$P(^(0),"^",2)
  1. I 'PSDTYPE!('PSDDAT) K PSDTYPE,PSDDAT Q
  1. K ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA),PSDTYPE,PSDDAT
  1. Q