XUCT031.m

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 ---XUCT031   590     printed  Mar 13, 2025@21:14:08                                                                                                                                                                                                      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