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