ORD11 ; COMPILED XREF FOR FILE #101 ; 04/16/99
;
S DIKZK=2
S DIKZ(0)=$G(^ORD(101,DA,0))
S X=$P(DIKZ(0),U,1)
I X'="" K ^ORD(101,"B",$E(X,1,63),DA)
S X=$P(DIKZ(0),U,2)
I X'="" S ORKX=X D UP^ORDD1 K ^ORD(101,"C",$E(X,1,63),DA) S X=ORKX K ORKX
S X=$P(DIKZ(0),U,2)
I X'="" D REDO^ORDD101
S X=$P(DIKZ(0),U,2)
I X'="" D K12^ORDD1
S DIKZ(5)=$G(^ORD(101,DA,5))
S X=$P(DIKZ(5),U,1)
I X'="" K ^ORD(101,"AE",$E(X,1,30),DA)
S DIKZ(4)=$G(^ORD(101,DA,4))
S X=$P(DIKZ(4),U,1)
I X'="" D REDO^ORDD101
S DIKZ(99)=$G(^ORD(101,DA,99))
S X=$P(DIKZ(99),U,1)
I X'="" D KILL^ORDD101
S DIKZ(770)=$G(^ORD(101,DA,770))
S X=$P(DIKZ(770),U,1)
I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^",3)&($P(HL770,"^",4)) ^ORD(101,"AHL1",X,$P(HL770,"^",3),$P(HL770,"^",4),DA)
S X=$P(DIKZ(770),U,2)
I X'="" K ^ORD(101,"AHL2",$E(X,1,30),DA)
S X=$P(DIKZ(770),U,3)
I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",4)) ^ORD(101,"AHL1",$P(HL770,"^"),X,$P(HL770,"^",4),DA)
S X=$P(DIKZ(770),U,4)
I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",3)) ^ORD(101,"AHL1",$P(HL770,"^"),$P(HL770,"^",3),X,DA)
END G ^ORD12
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORD11 1191 printed Apr 09, 2024@21:41:16 Page 2
ORD11 ; COMPILED XREF FOR FILE #101 ; 04/16/99
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^ORD(101,DA,0))
+4 SET X=$PIECE(DIKZ(0),U,1)
+5 IF X'=""
KILL ^ORD(101,"B",$EXTRACT(X,1,63),DA)
+6 SET X=$PIECE(DIKZ(0),U,2)
+7 IF X'=""
SET ORKX=X
DO UP^ORDD1
KILL ^ORD(101,"C",$EXTRACT(X,1,63),DA)
SET X=ORKX
KILL ORKX
+8 SET X=$PIECE(DIKZ(0),U,2)
+9 IF X'=""
DO REDO^ORDD101
+10 SET X=$PIECE(DIKZ(0),U,2)
+11 IF X'=""
DO K12^ORDD1
+12 SET DIKZ(5)=$GET(^ORD(101,DA,5))
+13 SET X=$PIECE(DIKZ(5),U,1)
+14 IF X'=""
KILL ^ORD(101,"AE",$EXTRACT(X,1,30),DA)
+15 SET DIKZ(4)=$GET(^ORD(101,DA,4))
+16 SET X=$PIECE(DIKZ(4),U,1)
+17 IF X'=""
DO REDO^ORDD101
+18 SET DIKZ(99)=$GET(^ORD(101,DA,99))
+19 SET X=$PIECE(DIKZ(99),U,1)
+20 IF X'=""
DO KILL^ORDD101
+21 SET DIKZ(770)=$GET(^ORD(101,DA,770))
+22 SET X=$PIECE(DIKZ(770),U,1)
+23 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^",3)&($PIECE(HL770,"^",4))
KILL ^ORD(101,"AHL1",X,$PIECE(HL770,"^",3),$PIECE(HL770,"^",4),DA)
+24 SET X=$PIECE(DIKZ(770),U,2)
+25 IF X'=""
KILL ^ORD(101,"AHL2",$EXTRACT(X,1,30),DA)
+26 SET X=$PIECE(DIKZ(770),U,3)
+27 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^")&($PIECE(HL770,"^",4))
KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),X,$PIECE(HL770,"^",4),DA)
+28 SET X=$PIECE(DIKZ(770),U,4)
+29 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^")&($PIECE(HL770,"^",3))
KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),$PIECE(HL770,"^",3),X,DA)
END GOTO ^ORD12
