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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDUTL4 1942 printed Dec 13, 2024@01:49:20 Page 2
PSDUTL4 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 22 Jun 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
SAD ;sets 'AD' x-ref on field 2 in file 58.89
+1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
IF 'PSDNL
KILL PSDNL
QUIT
+2 SET ^PSD(58.89,"AD",X,PSDNL,DA)=""
KILL PSDNL
+3 QUIT
KAD ;kills 'AD' x-ref on field 2 in file 58.89
+1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
IF 'PSDNL
KILL PSDNL
QUIT
+2 KILL ^PSD(58.89,"AD",X,PSDNL,DA),PSDNL
+3 QUIT
SAD1 ;sets 'AD' x-ref on field 6 in file 58.89
+1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",3)
IF 'PSDDAT
KILL PSDDAT
QUIT
+2 SET ^PSD(58.89,"AD",PSDDAT,X,DA)=""
KILL PSDDAT
+3 QUIT
KAD1 ;kills 'AD' x-ref on field 6 in file 58.89
+1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",3)
IF 'PSDDAT
KILL PSDDAT
QUIT
+2 KILL ^PSD(58.89,"AD",PSDDAT,X,DA),PSDDAT
+3 QUIT
SAE ;sets 'AE' x-ref on field 4 in file 58.89
+1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
IF 'PSDNL
KILL PSDNL
QUIT
+2 SET ^PSD(58.89,"AE",X,PSDNL,DA)=""
KILL PSDNL
+3 QUIT
KAE ;kills 'AE' x-ref on field 4 in file 58.89
+1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
IF 'PSDNL
KILL PSDNL
QUIT
+2 KILL ^PSD(58.89,"AE",X,PSDNL,DA),PSDNL
+3 QUIT
SAE1 ;sets 'AE' x-ref on field 6 in file 58.89
+1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",5)
IF 'PSDDAT
KILL PSDDAT
QUIT
+2 SET ^PSD(58.89,"AE",PSDDAT,X,DA)=""
KILL PSDDAT
+3 QUIT
KAE1 ;kills 'AE' x-ref on field 6 in file 58.89
+1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",5)
IF 'PSDDAT
KILL PSDDAT
QUIT
+2 KILL ^PSD(58.89,"AE",PSDDAT,X,DA),PSDDAT
+3 QUIT
SAK ;sets 'AK' x-ref on field 21 in file 58.81
+1 SET PSDNL=+$PIECE(^PSD(58.81,DA,0),"^",18)
IF 'PSDNL
KILL PSDNL
QUIT
+2 SET ^PSD(58.81,"AK",X,PSDNL,DA)=""
KILL PSDNL
+3 QUIT
KAK ;kills 'AK' x-ref on field 21 in file 58.81
+1 SET PSDNL=+$PIECE(^PSD(58.81,DA,0),"^",18)
IF 'PSDNL
KILL PSDNL
QUIT
+2 KILL ^PSD(58.81,"AK",X,PSDNL,DA),PSDNL
+3 QUIT
SAK1 ;sets 'AK' x-ref on field 17 in file 58.81
+1 SET PSDDAT=+$PIECE($GET(^PSD(58.81,DA,1)),"^",4)
IF 'PSDDAT
KILL PSDDAT
QUIT
+2 SET ^PSD(58.81,"AK",PSDDAT,X,DA)=""
KILL PSDDAT
+3 QUIT
KAK1 ;kills 'AK' x-ref on field 17 in file 58.81
+1 SET PSDDAT=+$PIECE($GET(^PSD(58.81,DA,1)),"^",4)
IF 'PSDDAT
KILL PSDDAT
QUIT
+2 KILL ^PSD(58.81,"AK",PSDDAT,X,DA),PSDDAT
+3 QUIT
