XUCT032 ; COMPILED XREF FOR FILE #3.081 ; 02/11/20
;
S DIKZK=1
S DIKZ(0)=$G(^XUSEC(0,DA,0))
S X=$P($G(DIKZ(0)),U,1)
I X'="" S ^XUSEC(0,"CUR",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,4)
I X'="" K ^XUSEC(0,"CUR",+^XUSEC(0,DA,0),DA)
S X=$P($G(DIKZ(0)),U,4)
I X'="" N %,Y S %=^XUSEC(0,DA,0) K:$L($P(%,U,11)) ^XUSEC(0,"AS1",$P($P(%,U,11),":"),DA) K:$L($P(%,U,12)) ^XUSEC(0,"AS2",$P($P(%,U,12),":"),DA) S Y=$G(^XUSEC(0,DA,1)) K:$L($P(Y,U)) ^XUSEC(0,"AS4",$P(Y,U),DA)
S X=$P($G(DIKZ(0)),U,4)
I X'="" N %,Y S %=^XUSEC(0,DA,0) I $L($P(%,U,11)) K ^XUSEC(0,"AS3",$P(%,U),$P($P(%,U,11),":"),DA) S Y=$G(^XUSEC(0,DA,1)) K:$L($P(Y,U)) ^XUSEC(0,"AS5",$P(%,U),$P(Y,U),DA)
S X=$P($G(DIKZ(0)),U,7)
I X'="" S ^XUSEC(0,"ALDEV",X)=+^XUSEC(0,DA,0)
S X=$P($G(DIKZ(0)),U,11)
I X'="" S:'$P(^XUSEC(0,DA,0),U,4) ^XUSEC(0,"AS1",$P(X,":"),DA)=""
S X=$P($G(DIKZ(0)),U,11)
I X'="" N % S %=^XUSEC(0,DA,0) I '$P(%,U,4) S ^XUSEC(0,"AS3",$P(%,U),$P(X,":"),DA)=""
S X=$P($G(DIKZ(0)),U,12)
I X'="" S:'$P(^XUSEC(0,DA,0),U,4) ^XUSEC(0,"AS2",$P(X,":"),DA)=""
S DIKZ(1)=$G(^XUSEC(0,DA,1))
S X=$P($G(DIKZ(1)),U,1)
I X'="" S:'$P(^XUSEC(0,DA,0),U,4) ^XUSEC(0,"AS4",X,DA)=""
S X=$P($G(DIKZ(1)),U,1)
I X'="" N % S %=^XUSEC(0,DA,0) I '$P(%,U,4) S ^XUSEC(0,"AS5",$P(%,U),X,DA)=""
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUCT032 1286 printed Nov 22, 2024@17:19:23 Page 2
XUCT032 ; COMPILED XREF FOR FILE #3.081 ; 02/11/20
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^XUSEC(0,DA,0))
+4 SET X=$PIECE($GET(DIKZ(0)),U,1)
+5 IF X'=""
SET ^XUSEC(0,"CUR",$EXTRACT(X,1,30),DA)=""
+6 SET X=$PIECE($GET(DIKZ(0)),U,4)
+7 IF X'=""
KILL ^XUSEC(0,"CUR",+^XUSEC(0,DA,0),DA)
+8 SET X=$PIECE($GET(DIKZ(0)),U,4)
+9 IF X'=""
NEW %,Y
SET %=^XUSEC(0,DA,0)
if $LENGTH($PIECE(%,U,11))
KILL ^XUSEC(0,"AS1",$PIECE($PIECE(%,U,11),":"),DA)
if $LENGTH($PIECE(%,U,12))
KILL ^XUSEC(0,"AS2",$PIECE($PIECE(%,U,12),":"),DA)
SET Y=$GET(^XUSEC(0,DA,1))
if $LENGTH($PIECE(Y,U))
KILL ^XUSEC(0,"AS4",$PIECE(Y,U),DA)
+10 SET X=$PIECE($GET(DIKZ(0)),U,4)
+11 IF X'=""
NEW %,Y
SET %=^XUSEC(0,DA,0)
IF $LENGTH($PIECE(%,U,11))
KILL ^XUSEC(0,"AS3",$PIECE(%,U),$PIECE($PIECE(%,U,11),":"),DA)
SET Y=$GET(^XUSEC(0,DA,1))
if $LENGTH($PIECE(Y,U))
KILL ^XUSEC(0,"AS5",$PIECE(%,U),$PIECE(Y,U),DA)
+12 SET X=$PIECE($GET(DIKZ(0)),U,7)
+13 IF X'=""
SET ^XUSEC(0,"ALDEV",X)=+^XUSEC(0,DA,0)
+14 SET X=$PIECE($GET(DIKZ(0)),U,11)
+15 IF X'=""
if '$PIECE(^XUSEC(0,DA,0),U,4)
SET ^XUSEC(0,"AS1",$PIECE(X,":"),DA)=""
+16 SET X=$PIECE($GET(DIKZ(0)),U,11)
+17 IF X'=""
NEW %
SET %=^XUSEC(0,DA,0)
IF '$PIECE(%,U,4)
SET ^XUSEC(0,"AS3",$PIECE(%,U),$PIECE(X,":"),DA)=""
+18 SET X=$PIECE($GET(DIKZ(0)),U,12)
+19 IF X'=""
if '$PIECE(^XUSEC(0,DA,0),U,4)
SET ^XUSEC(0,"AS2",$PIECE(X,":"),DA)=""
+20 SET DIKZ(1)=$GET(^XUSEC(0,DA,1))
+21 SET X=$PIECE($GET(DIKZ(1)),U,1)
+22 IF X'=""
if '$PIECE(^XUSEC(0,DA,0),U,4)
SET ^XUSEC(0,"AS4",X,DA)=""
+23 SET X=$PIECE($GET(DIKZ(1)),U,1)
+24 IF X'=""
NEW %
SET %=^XUSEC(0,DA,0)
IF '$PIECE(%,U,4)
SET ^XUSEC(0,"AS5",$PIECE(%,U),X,DA)=""
END QUIT
