XQORC1 ; COMPILED XREF FOR FILE #101 ; 04/21/09
;
S DIKZK=2
S DIKZ(0)=$G(^ORD(101,DA,0))
S X=$P(DIKZ(0),U,2)
I X'="" S ORKX=X D UP^XQORDD1 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^XQORD101
S X=$P(DIKZ(0),U,2)
I X'="" D K12^XQORDD1
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^XQORD101
S DIKZ(99)=$G(^ORD(101,DA,99))
S X=$P(DIKZ(99),U,1)
I X'="" D KILL^XQORD101
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))&($P(HL770,"^",10)) ^ORD(101,"AHL1",X,$P(HL770,"^",3),$P(HL770,"^",4),$P(HL770,"^",10),DA)
S X=$P(DIKZ(770),U,1)
I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^",3)&($P(HL770,"^",10)) ^ORD(101,"AHL21",X,$P(HL770,"^",3),$P(HL770,"^",10),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))&($P(HL770,"^",10)) ^ORD(101,"AHL1",$P(HL770,"^"),X,$P(HL770,"^",4),$P(HL770,"^",10),DA)
S X=$P(DIKZ(770),U,3)
I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",10)) ^ORD(101,"AHL21",$P(HL770,"^"),X,$P(HL770,"^",10),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))&($P(HL770,"^",10)) ^ORD(101,"AHL1",$P(HL770,"^"),$P(HL770,"^",3),X,$P(HL770,"^",10),DA)
S X=$P(DIKZ(770),U,10)
I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",3))&($P(HL770,"^",4)) ^ORD(101,"AHL1",$P(HL770,"^"),$P(HL770,"^",3),$P(HL770,"^",4),X,DA)
S X=$P(DIKZ(770),U,10)
I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",3)) ^ORD(101,"AHL21",$P(HL770,"^"),$P(HL770,"^",3),X,DA)
S X=$P(DIKZ(0),U,1)
I X'="" K ^ORD(101,"B",$E(X,1,63),DA)
END G ^XQORC2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQORC1 1983 printed Dec 13, 2024@02:06 Page 2
XQORC1 ; COMPILED XREF FOR FILE #101 ; 04/21/09
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^ORD(101,DA,0))
+4 SET X=$PIECE(DIKZ(0),U,2)
+5 IF X'=""
SET ORKX=X
DO UP^XQORDD1
KILL ^ORD(101,"C",$EXTRACT(X,1,63),DA)
SET X=ORKX
KILL ORKX
+6 SET X=$PIECE(DIKZ(0),U,2)
+7 IF X'=""
DO REDO^XQORD101
+8 SET X=$PIECE(DIKZ(0),U,2)
+9 IF X'=""
DO K12^XQORDD1
+10 SET DIKZ(5)=$GET(^ORD(101,DA,5))
+11 SET X=$PIECE(DIKZ(5),U,1)
+12 IF X'=""
KILL ^ORD(101,"AE",$EXTRACT(X,1,30),DA)
+13 SET DIKZ(4)=$GET(^ORD(101,DA,4))
+14 SET X=$PIECE(DIKZ(4),U,1)
+15 IF X'=""
DO REDO^XQORD101
+16 SET DIKZ(99)=$GET(^ORD(101,DA,99))
+17 SET X=$PIECE(DIKZ(99),U,1)
+18 IF X'=""
DO KILL^XQORD101
+19 SET DIKZ(770)=$GET(^ORD(101,DA,770))
+20 SET X=$PIECE(DIKZ(770),U,1)
+21 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^",3)&($PIECE(HL770,"^",4))&($PIECE(HL770,"^",10))
KILL ^ORD(101,"AHL1",X,$PIECE(HL770,"^",3),$PIECE(HL770,"^",4),$PIECE(HL770,"^",10),DA)
+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,"^",10))
KILL ^ORD(101,"AHL21",X,$PIECE(HL770,"^",3),$PIECE(HL770,"^",10),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))&($PIECE(HL770,"^",10))
KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),X,$PIECE(HL770,"^",4),$PIECE(HL770,"^",10),DA)
+28 SET X=$PIECE(DIKZ(770),U,3)
+29 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^")&($PIECE(HL770,"^",10))
KILL ^ORD(101,"AHL21",$PIECE(HL770,"^"),X,$PIECE(HL770,"^",10),DA)
+30 SET X=$PIECE(DIKZ(770),U,4)
+31 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^")&($PIECE(HL770,"^",3))&($PIECE(HL770,"^",10))
KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),$PIECE(HL770,"^",3),X,$PIECE(HL770,"^",10),DA)
+32 SET X=$PIECE(DIKZ(770),U,10)
+33 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^")&($PIECE(HL770,"^",3))&($PIECE(HL770,"^",4))
KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),$PIECE(HL770,"^",3),$PIECE(HL770,"^",4),X,DA)
+34 SET X=$PIECE(DIKZ(770),U,10)
+35 IF X'=""
NEW HL770
SET HL770=$GET(^ORD(101,DA,770))
if $PIECE(HL770,"^")&($PIECE(HL770,"^",3))
KILL ^ORD(101,"AHL21",$PIECE(HL770,"^"),$PIECE(HL770,"^",3),X,DA)
+36 SET X=$PIECE(DIKZ(0),U,1)
+37 IF X'=""
KILL ^ORD(101,"B",$EXTRACT(X,1,63),DA)
END GOTO ^XQORC2
