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

PSDUTL4.m

Go to the documentation of this file.
  1. PSDUTL4 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 22 Jun 94
  1. ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
  1. SAD ;sets 'AD' x-ref on field 2 in file 58.89
  1. S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
  1. S ^PSD(58.89,"AD",X,PSDNL,DA)="" K PSDNL
  1. Q
  1. KAD ;kills 'AD' x-ref on field 2 in file 58.89
  1. S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
  1. K ^PSD(58.89,"AD",X,PSDNL,DA),PSDNL
  1. Q
  1. SAD1 ;sets 'AD' x-ref on field 6 in file 58.89
  1. S PSDDAT=+$P(^PSD(58.89,DA,0),"^",3) I 'PSDDAT K PSDDAT Q
  1. S ^PSD(58.89,"AD",PSDDAT,X,DA)="" K PSDDAT
  1. Q
  1. KAD1 ;kills 'AD' x-ref on field 6 in file 58.89
  1. S PSDDAT=+$P(^PSD(58.89,DA,0),"^",3) I 'PSDDAT K PSDDAT Q
  1. K ^PSD(58.89,"AD",PSDDAT,X,DA),PSDDAT
  1. Q
  1. SAE ;sets 'AE' x-ref on field 4 in file 58.89
  1. S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
  1. S ^PSD(58.89,"AE",X,PSDNL,DA)="" K PSDNL
  1. Q
  1. KAE ;kills 'AE' x-ref on field 4 in file 58.89
  1. S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
  1. K ^PSD(58.89,"AE",X,PSDNL,DA),PSDNL
  1. Q
  1. SAE1 ;sets 'AE' x-ref on field 6 in file 58.89
  1. S PSDDAT=+$P(^PSD(58.89,DA,0),"^",5) I 'PSDDAT K PSDDAT Q
  1. S ^PSD(58.89,"AE",PSDDAT,X,DA)="" K PSDDAT
  1. Q
  1. KAE1 ;kills 'AE' x-ref on field 6 in file 58.89
  1. S PSDDAT=+$P(^PSD(58.89,DA,0),"^",5) I 'PSDDAT K PSDDAT Q
  1. K ^PSD(58.89,"AE",PSDDAT,X,DA),PSDDAT
  1. Q
  1. SAK ;sets 'AK' x-ref on field 21 in file 58.81
  1. S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
  1. S ^PSD(58.81,"AK",X,PSDNL,DA)="" K PSDNL
  1. Q
  1. KAK ;kills 'AK' x-ref on field 21 in file 58.81
  1. S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
  1. K ^PSD(58.81,"AK",X,PSDNL,DA),PSDNL
  1. Q
  1. SAK1 ;sets 'AK' x-ref on field 17 in file 58.81
  1. S PSDDAT=+$P($G(^PSD(58.81,DA,1)),"^",4) I 'PSDDAT K PSDDAT Q
  1. S ^PSD(58.81,"AK",PSDDAT,X,DA)="" K PSDDAT
  1. Q
  1. KAK1 ;kills 'AK' x-ref on field 17 in file 58.81
  1. S PSDDAT=+$P($G(^PSD(58.81,DA,1)),"^",4) I 'PSDDAT K PSDDAT Q
  1. K ^PSD(58.81,"AK",PSDDAT,X,DA),PSDDAT
  1. Q