PSDUTL3 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 18 Jan 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
SAC ;sets 'AC' x-ref on field 10 in file 58.86
S PSDDRU=+$P(^PSD(58.86,DA,0),"^",2),PSDNL=+$P(^(0),"^",7) I 'PSDDRU!('PSDNL) K PSDDDU,PSDNL Q
S ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA)="" K PSDDRU,PSDNL
Q
KAC ;kills 'AC' x-ref on field 10 in file 58.86
S PSDDRU=+$P(^PSD(58.86,DA,0),"^",2),PSDNL=+$P(^(0),"^",7) I 'PSDDRU!('PSDNL) K PSDDRU,PSDNL Q
K ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
Q
SAC1 ;sets 'AC' x-ref on field 1 in file 58.86
S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
S ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA)="" K PSDDAT,PSDNL
Q
KAC1 ;kills 'AC' x-ref on field 1 in file 58.86
S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
K ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
Q
SAC2 ;sets 'AC' x-ref on field 6 in file 58.86
S PSDDRU=$P(^PSD(58.86,DA,0),"^",2),PSDDAT=$P(^(0),"^",11) I 'PSDDRU!('PSDDAT) K PSDDRU,PSDDAT Q
S ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA)="" K PSDDAT,PSDDRU
Q
KAC2 ;kills 'AC' x-ref on field 6 in file 58.86
S PSDDRU=$P(^PSD(58.86,DA,0),"^",2),PSDDAT=$P(^(0),"^",11) I 'PSDDRU!('PSDDAT) K PSDDRU,PSDDAT Q
K ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
Q
SAD ;sets 'AD' x-ref on field 10 in file 58.86
S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDNL=+$P(^(0),"^",7) I PSDDRU']""!('PSDNL) K PSDDRU,PSDNL Q
S ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA)="" K PSDDRU,PSDNL
Q
KAD ;kills 'AD' x-ref on field 10 in file 58.86
S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDNL=+$P(^(0),"^",7) I PSDDRU']""!('PSDNL) K PSDDRU,PSDNL Q
K ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
Q
SAD1 ;sets 'AD' x-ref on field 13 in file 58.86
S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
S ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA)="" K PSDDAT,PSDNL
Q
KAD1 ;kills 'AD' x-ref on field 13 in file 58.86
S PSDDAT=+$P(^PSD(58.86,DA,0),"^",11),PSDNL=+$P(^(0),"^",7) I 'PSDDAT!('PSDNL) K PSDDAT,PSDNL Q
K ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
Q
SAD2 ;sets 'AD' x-ref on field 6 in file 58.86
S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDDAT=$P(^(0),"^",11) I PSDDRU']""!('PSDDAT) K PSDDRU,PSDDAT Q
S ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA)="" K PSDDAT,PSDDRU
Q
KAD2 ;kills 'AD' x-ref on field 6 in file 58.86
S PSDDRU=$P($G(^PSD(58.86,DA,1)),"^"),PSDDAT=$P(^(0),"^",11) I PSDDRU']""!('PSDDAT) K PSDDRU,PSDDAT Q
K ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
Q
SACT7 ;set 'ACT' x-ref on field 37 in 58.81
S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=4
I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
S ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA)="" K PSDNL,PSDDRU,PSDTYPE
Q
KACT7 ;kill 'ACT' x-ref on field 37 in 58.81
S PSDNL=$P(^PSD(58.81,DA,0),"^",3),PSDDRU=$P(^(0),"^",5),PSDTYPE=4
I ('PSDNL)!('PSDDRU)!('PSDTYPE) K PSDNL,PSDDRU,PSDTYPE Q
K ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA),PSDNL,PSDDRU,PSDTYPE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDUTL3 3090 printed Oct 16, 2024@17:50:10 Page 2
PSDUTL3 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 18 Jan 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
SAC ;sets 'AC' x-ref on field 10 in file 58.86
+1 SET PSDDRU=+$PIECE(^PSD(58.86,DA,0),"^",2)
SET PSDNL=+$PIECE(^(0),"^",7)
IF 'PSDDRU!('PSDNL)
KILL PSDDDU,PSDNL
QUIT
+2 SET ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA)=""
KILL PSDDRU,PSDNL
+3 QUIT
KAC ;kills 'AC' x-ref on field 10 in file 58.86
+1 SET PSDDRU=+$PIECE(^PSD(58.86,DA,0),"^",2)
SET PSDNL=+$PIECE(^(0),"^",7)
IF 'PSDDRU!('PSDNL)
KILL PSDDRU,PSDNL
QUIT
+2 KILL ^PSD(58.86,"AC",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
+3 QUIT
SAC1 ;sets 'AC' x-ref on field 1 in file 58.86
+1 SET PSDDAT=+$PIECE(^PSD(58.86,DA,0),"^",11)
SET PSDNL=+$PIECE(^(0),"^",7)
IF 'PSDDAT!('PSDNL)
KILL PSDDAT,PSDNL
QUIT
+2 SET ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA)=""
KILL PSDDAT,PSDNL
+3 QUIT
KAC1 ;kills 'AC' x-ref on field 1 in file 58.86
+1 SET PSDDAT=+$PIECE(^PSD(58.86,DA,0),"^",11)
SET PSDNL=+$PIECE(^(0),"^",7)
IF 'PSDDAT!('PSDNL)
KILL PSDDAT,PSDNL
QUIT
+2 KILL ^PSD(58.86,"AC",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
+3 QUIT
SAC2 ;sets 'AC' x-ref on field 6 in file 58.86
+1 SET PSDDRU=$PIECE(^PSD(58.86,DA,0),"^",2)
SET PSDDAT=$PIECE(^(0),"^",11)
IF 'PSDDRU!('PSDDAT)
KILL PSDDRU,PSDDAT
QUIT
+2 SET ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA)=""
KILL PSDDAT,PSDDRU
+3 QUIT
KAC2 ;kills 'AC' x-ref on field 6 in file 58.86
+1 SET PSDDRU=$PIECE(^PSD(58.86,DA,0),"^",2)
SET PSDDAT=$PIECE(^(0),"^",11)
IF 'PSDDRU!('PSDDAT)
KILL PSDDRU,PSDDAT
QUIT
+2 KILL ^PSD(58.86,"AC",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
+3 QUIT
SAD ;sets 'AD' x-ref on field 10 in file 58.86
+1 SET PSDDRU=$PIECE($GET(^PSD(58.86,DA,1)),"^")
SET PSDNL=+$PIECE(^(0),"^",7)
IF PSDDRU']""!('PSDNL)
KILL PSDDRU,PSDNL
QUIT
+2 SET ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA)=""
KILL PSDDRU,PSDNL
+3 QUIT
KAD ;kills 'AD' x-ref on field 10 in file 58.86
+1 SET PSDDRU=$PIECE($GET(^PSD(58.86,DA,1)),"^")
SET PSDNL=+$PIECE(^(0),"^",7)
IF PSDDRU']""!('PSDNL)
KILL PSDDRU,PSDNL
QUIT
+2 KILL ^PSD(58.86,"AD",X,PSDNL,PSDDRU,DA),PSDDRU,PSDNL
+3 QUIT
SAD1 ;sets 'AD' x-ref on field 13 in file 58.86
+1 SET PSDDAT=+$PIECE(^PSD(58.86,DA,0),"^",11)
SET PSDNL=+$PIECE(^(0),"^",7)
IF 'PSDDAT!('PSDNL)
KILL PSDDAT,PSDNL
QUIT
+2 SET ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA)=""
KILL PSDDAT,PSDNL
+3 QUIT
KAD1 ;kills 'AD' x-ref on field 13 in file 58.86
+1 SET PSDDAT=+$PIECE(^PSD(58.86,DA,0),"^",11)
SET PSDNL=+$PIECE(^(0),"^",7)
IF 'PSDDAT!('PSDNL)
KILL PSDDAT,PSDNL
QUIT
+2 KILL ^PSD(58.86,"AD",PSDDAT,PSDNL,X,DA),PSDDAT,PSDNL
+3 QUIT
SAD2 ;sets 'AD' x-ref on field 6 in file 58.86
+1 SET PSDDRU=$PIECE($GET(^PSD(58.86,DA,1)),"^")
SET PSDDAT=$PIECE(^(0),"^",11)
IF PSDDRU']""!('PSDDAT)
KILL PSDDRU,PSDDAT
QUIT
+2 SET ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA)=""
KILL PSDDAT,PSDDRU
+3 QUIT
KAD2 ;kills 'AD' x-ref on field 6 in file 58.86
+1 SET PSDDRU=$PIECE($GET(^PSD(58.86,DA,1)),"^")
SET PSDDAT=$PIECE(^(0),"^",11)
IF PSDDRU']""!('PSDDAT)
KILL PSDDRU,PSDDAT
QUIT
+2 KILL ^PSD(58.86,"AD",PSDDAT,X,PSDDRU,DA),PSDDAT,PSDDRU
+3 QUIT
SACT7 ;set 'ACT' x-ref on field 37 in 58.81
+1 SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)
SET PSDDRU=$PIECE(^(0),"^",5)
SET PSDTYPE=4
+2 IF ('PSDNL)!('PSDDRU)!('PSDTYPE)
KILL PSDNL,PSDDRU,PSDTYPE
QUIT
+3 SET ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA)=""
KILL PSDNL,PSDDRU,PSDTYPE
+4 QUIT
KACT7 ;kill 'ACT' x-ref on field 37 in 58.81
+1 SET PSDNL=$PIECE(^PSD(58.81,DA,0),"^",3)
SET PSDDRU=$PIECE(^(0),"^",5)
SET PSDTYPE=4
+2 IF ('PSDNL)!('PSDDRU)!('PSDTYPE)
KILL PSDNL,PSDDRU,PSDTYPE
QUIT
+3 KILL ^PSD(58.81,"ACT",X,PSDNL,PSDDRU,PSDTYPE,DA),PSDNL,PSDDRU,PSDTYPE
+4 QUIT
