XQORDD1 ; slc/dcm - Calls from OE/RR DD ;9/24/98 16:41
;;8.0;KERNEL;**98**;Sept 24, 1998
K11 ;;Set logic from field 1 file 101
S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA,3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" S ^ORD(101,"K."_ORKEY,X,DA)=""
S X=ORKX K ORKEY,ORKX
Q
K12 ;;Kill logic from field 1 file 101
S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA,3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" K ^ORD(101,"K."_ORKEY,X,DA)
S X=ORKX K ORKEY,ORKX
Q
K21 ;;Set logic from field 2 file 101
S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA(1),3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" S ^ORD(101,"K."_ORKEY,X,DA(1))=""
S X=ORKX K ORKEY,ORITN
Q
K22 ;;Kill logic from field 2 file 101
S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA(1),3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" K ^ORD(101,"K."_ORKEY,X,DA(1))
S X=ORKX K ORKEY,ORKX
Q
K31 ;;Set logic from field 3 file 101
S ORKEY=$S($D(^DIC(19.1,X,0)):^(0),1:"") I ORKEY="" K ORKEY Q
I ORKEY'="ORWARD" K ORKEY Q
S ORKX=X,X=$P(^ORD(101,DA(1),0),"^",2) I $L(X) D UP S ^ORD(101,"K."_ORKEY,X,DA(1))=""
S I=0 F J=0:0 S I=$O(^ORD(101,DA(1),2,I)) Q:I<1 S X=$P(^(I,0),"^") I $L(X) D UP S ^ORD(101,"K."_ORKEY,X,DA(1))=""
S X=ORKX K ORKEY,ORKX
Q
K32 ;;Kill logic from field 3 file 101
S ORKEY=$S($D(^DIC(19.1,X,0)):^(0),1:"") I ORKEY="" K ORKEY Q
I ORKEY'="ORWARD" K ORKEY Q
S ORKX=X,X=$P(^ORD(101,DA(1),0),"^",2) I $L(X) D UP K ^ORD(101,"K."_ORKEY,X,DA(1))
S I=0 F J=0:0 S I=$O(^ORD(101,DA(1),2,I)) Q:I<1 S X=$P(^(I,0),"^") I $L(X) D UP K ^ORD(101,"K."_ORKEY,X,DA(1))
S X=ORKX K ORKEY,ORKX
Q
UP S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
F1 ;Set logic (NOT CURRENTLY IN USE)
I $D(@("^"_$P(X,";",2)_"0)")) S ORF="F."_+$P(^(0),"^",2),T=$P(^ORD(101,DA,0),"^",2) I $L(T) S ^ORD(101,ORF,T,DA)=""
K T Q
F2 ;Kill logic
I $D(@("^"_$P(X,";",2)_"0)")) S ORF="F."_+$P(^(0),"^",2),T=$P(^ORD(101,DA,0),"^",2) I $L(T) K ^ORD(101,ORF,T,DA)
K T Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQORDD1 2169 printed Dec 13, 2024@02:06:16 Page 2
XQORDD1 ; slc/dcm - Calls from OE/RR DD ;9/24/98 16:41
+1 ;;8.0;KERNEL;**98**;Sept 24, 1998
K11 ;;Set logic from field 1 file 101
+1 SET I=0
SET ORKX=X
DO UP
FOR J=0:0
SET I=$ORDER(^ORD(101,DA,3,I))
if I<1
QUIT
SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
IF $LENGTH(ORKEY)
IF ORKEY="ORWARD"
SET ^ORD(101,"K."_ORKEY,X,DA)=""
+2 SET X=ORKX
KILL ORKEY,ORKX
+3 QUIT
K12 ;;Kill logic from field 1 file 101
+1 SET I=0
SET ORKX=X
DO UP
FOR J=0:0
SET I=$ORDER(^ORD(101,DA,3,I))
if I<1
QUIT
SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
IF $LENGTH(ORKEY)
IF ORKEY="ORWARD"
KILL ^ORD(101,"K."_ORKEY,X,DA)
+2 SET X=ORKX
KILL ORKEY,ORKX
+3 QUIT
K21 ;;Set logic from field 2 file 101
+1 SET I=0
SET ORKX=X
DO UP
FOR J=0:0
SET I=$ORDER(^ORD(101,DA(1),3,I))
if I<1
QUIT
SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
IF $LENGTH(ORKEY)
IF ORKEY="ORWARD"
SET ^ORD(101,"K."_ORKEY,X,DA(1))=""
+2 SET X=ORKX
KILL ORKEY,ORITN
+3 QUIT
K22 ;;Kill logic from field 2 file 101
+1 SET I=0
SET ORKX=X
DO UP
FOR J=0:0
SET I=$ORDER(^ORD(101,DA(1),3,I))
if I<1
QUIT
SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
IF $LENGTH(ORKEY)
IF ORKEY="ORWARD"
KILL ^ORD(101,"K."_ORKEY,X,DA(1))
+2 SET X=ORKX
KILL ORKEY,ORKX
+3 QUIT
K31 ;;Set logic from field 3 file 101
+1 SET ORKEY=$SELECT($DATA(^DIC(19.1,X,0)):^(0),1:"")
IF ORKEY=""
KILL ORKEY
QUIT
+2 IF ORKEY'="ORWARD"
KILL ORKEY
QUIT
+3 SET ORKX=X
SET X=$PIECE(^ORD(101,DA(1),0),"^",2)
IF $LENGTH(X)
DO UP
SET ^ORD(101,"K."_ORKEY,X,DA(1))=""
+4 SET I=0
FOR J=0:0
SET I=$ORDER(^ORD(101,DA(1),2,I))
if I<1
QUIT
SET X=$PIECE(^(I,0),"^")
IF $LENGTH(X)
DO UP
SET ^ORD(101,"K."_ORKEY,X,DA(1))=""
+5 SET X=ORKX
KILL ORKEY,ORKX
+6 QUIT
K32 ;;Kill logic from field 3 file 101
+1 SET ORKEY=$SELECT($DATA(^DIC(19.1,X,0)):^(0),1:"")
IF ORKEY=""
KILL ORKEY
QUIT
+2 IF ORKEY'="ORWARD"
KILL ORKEY
QUIT
+3 SET ORKX=X
SET X=$PIECE(^ORD(101,DA(1),0),"^",2)
IF $LENGTH(X)
DO UP
KILL ^ORD(101,"K."_ORKEY,X,DA(1))
+4 SET I=0
FOR J=0:0
SET I=$ORDER(^ORD(101,DA(1),2,I))
if I<1
QUIT
SET X=$PIECE(^(I,0),"^")
IF $LENGTH(X)
DO UP
KILL ^ORD(101,"K."_ORKEY,X,DA(1))
+5 SET X=ORKX
KILL ORKEY,ORKX
+6 QUIT
UP SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 QUIT
F1 ;Set logic (NOT CURRENTLY IN USE)
+1 IF $DATA(@("^"_$PIECE(X,";",2)_"0)"))
SET ORF="F."_+$PIECE(^(0),"^",2)
SET T=$PIECE(^ORD(101,DA,0),"^",2)
IF $LENGTH(T)
SET ^ORD(101,ORF,T,DA)=""
+2 KILL T
QUIT
F2 ;Kill logic
+1 IF $DATA(@("^"_$PIECE(X,";",2)_"0)"))
SET ORF="F."_+$PIECE(^(0),"^",2)
SET T=$PIECE(^ORD(101,DA,0),"^",2)
IF $LENGTH(T)
KILL ^ORD(101,ORF,T,DA)
+2 KILL T
QUIT
