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