PSDUTL2 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 6 Sept 92
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
SAG ;sets 'AG' xref in file 58.81 (field 11)
S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
S ^PSD(58.81,"AG",X,PSDNL,DA)="" K PSDNL
Q
KAG ;kills 'AG' x-ref in file 58.81 (field 11)
S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
K ^PSD(58.81,"AG",X,PSDNL,DA),PSDNL
Q
SAG1 ;set 'AG' x-ref on field 17 in 58.81
S PSDOST=+$P(^PSD(58.81,DA,0),"^",12) I 'PSDOST K PSDOST Q
S ^PSD(58.81,"AG",PSDOST,X,DA)="" K PSDOST
Q
KAG1 ;kill 'AG' x-ref on field 17 in 58.81
S PSDOST=+$P(^PSD(58.81,DA,0),"^",12) I 'PSDOST K PSDOST Q
K ^PSD(58.81,"AG",PSDOST,X,DA),PSDOST
Q
SAC ;set 'AC' x-ref on field 1 in 58.87
S PSDNL=+$P(^PSD(58.87,DA,0),"^",13) I 'PSDNL K PSDNL Q
S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12) I 'PSDTYPE K PSDTYPE Q
S ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA)="" K PSDNL,PSDTYPE
Q
KAC ;kill 'AC' x-ref on field 1 in 58.87
S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDTYPE=+$P(^(0),"^",12)
I 'PSDNL!('PSDTYPE) K PSDNL,PSDTYPE Q
K ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA),PSDNL,PSDTYPE
Q
SAC1 ;set 'AC' x-ref on field 11 in 58.87
S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDDAT=+$P(^(0),"^",2)
I 'PSDNL!('PSDDAT) K PSDNL,PSDDAT Q
S ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA)="" K PSDNL,PSDDAT
Q
KAC1 ;kill 'AC' x-ref on field 11 in 58.87
S PSDNL=+$P(^PSD(58.87,DA,0),"^",13),PSDDAT=+$P(^(0),"^",2)
I 'PSDNL!('PSDDAT) K PSDNL,PSDDAT Q
K ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA),PSDNL,PSDDAT
Q
SAC2 ;set 'AC' x-ref on field 12 in 58.87
S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12),PSDDAT=+$P(^(0),"^",2)
I 'PSDTYPE!('PSDDAT) K PSDTYPE,PSDDAT Q
S ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA)="" K PSDTYPE,PSDDAT
Q
KAC2 ;kill 'AC' x-ref on field 12 in 58.87
S PSDTYPE=+$P(^PSD(58.87,DA,0),"^",12),PSDDAT=+$P(^(0),"^",2)
I 'PSDTYPE!('PSDDAT) K PSDTYPE,PSDDAT Q
K ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA),PSDTYPE,PSDDAT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDUTL2 1963 printed Nov 22, 2024@16:59:29 Page 2
PSDUTL2 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 6 Sept 92
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
SAG ;sets 'AG' xref in file 58.81 (field 11)
+1 SET PSDNL=+$PIECE(^PSD(58.81,DA,0),"^",18)
IF 'PSDNL
KILL PSDNL
QUIT
+2 SET ^PSD(58.81,"AG",X,PSDNL,DA)=""
KILL PSDNL
+3 QUIT
KAG ;kills 'AG' x-ref in file 58.81 (field 11)
+1 SET PSDNL=+$PIECE(^PSD(58.81,DA,0),"^",18)
IF 'PSDNL
KILL PSDNL
QUIT
+2 KILL ^PSD(58.81,"AG",X,PSDNL,DA),PSDNL
+3 QUIT
SAG1 ;set 'AG' x-ref on field 17 in 58.81
+1 SET PSDOST=+$PIECE(^PSD(58.81,DA,0),"^",12)
IF 'PSDOST
KILL PSDOST
QUIT
+2 SET ^PSD(58.81,"AG",PSDOST,X,DA)=""
KILL PSDOST
+3 QUIT
KAG1 ;kill 'AG' x-ref on field 17 in 58.81
+1 SET PSDOST=+$PIECE(^PSD(58.81,DA,0),"^",12)
IF 'PSDOST
KILL PSDOST
QUIT
+2 KILL ^PSD(58.81,"AG",PSDOST,X,DA),PSDOST
+3 QUIT
SAC ;set 'AC' x-ref on field 1 in 58.87
+1 SET PSDNL=+$PIECE(^PSD(58.87,DA,0),"^",13)
IF 'PSDNL
KILL PSDNL
QUIT
+2 SET PSDTYPE=+$PIECE(^PSD(58.87,DA,0),"^",12)
IF 'PSDTYPE
KILL PSDTYPE
QUIT
+3 SET ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA)=""
KILL PSDNL,PSDTYPE
+4 QUIT
KAC ;kill 'AC' x-ref on field 1 in 58.87
+1 SET PSDNL=+$PIECE(^PSD(58.87,DA,0),"^",13)
SET PSDTYPE=+$PIECE(^(0),"^",12)
+2 IF 'PSDNL!('PSDTYPE)
KILL PSDNL,PSDTYPE
QUIT
+3 KILL ^PSD(58.87,"AC",PSDTYPE,PSDNL,X,DA),PSDNL,PSDTYPE
+4 QUIT
SAC1 ;set 'AC' x-ref on field 11 in 58.87
+1 SET PSDNL=+$PIECE(^PSD(58.87,DA,0),"^",13)
SET PSDDAT=+$PIECE(^(0),"^",2)
+2 IF 'PSDNL!('PSDDAT)
KILL PSDNL,PSDDAT
QUIT
+3 SET ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA)=""
KILL PSDNL,PSDDAT
+4 QUIT
KAC1 ;kill 'AC' x-ref on field 11 in 58.87
+1 SET PSDNL=+$PIECE(^PSD(58.87,DA,0),"^",13)
SET PSDDAT=+$PIECE(^(0),"^",2)
+2 IF 'PSDNL!('PSDDAT)
KILL PSDNL,PSDDAT
QUIT
+3 KILL ^PSD(58.87,"AC",X,PSDNL,PSDDAT,DA),PSDNL,PSDDAT
+4 QUIT
SAC2 ;set 'AC' x-ref on field 12 in 58.87
+1 SET PSDTYPE=+$PIECE(^PSD(58.87,DA,0),"^",12)
SET PSDDAT=+$PIECE(^(0),"^",2)
+2 IF 'PSDTYPE!('PSDDAT)
KILL PSDTYPE,PSDDAT
QUIT
+3 SET ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA)=""
KILL PSDTYPE,PSDDAT
+4 QUIT
KAC2 ;kill 'AC' x-ref on field 12 in 58.87
+1 SET PSDTYPE=+$PIECE(^PSD(58.87,DA,0),"^",12)
SET PSDDAT=+$PIECE(^(0),"^",2)
+2 IF 'PSDTYPE!('PSDDAT)
KILL PSDTYPE,PSDDAT
QUIT
+3 KILL ^PSD(58.87,"AC",PSDTYPE,X,PSDDAT,DA),PSDTYPE,PSDDAT
+4 QUIT
