TIUXRC2.m

TIUXRC2 ; COMPILED XREF FOR FILE #8925 ; 09/22/15

 ; 

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(12)),U,8)

 I X'="" D KACLEC^TIUDD01(1208,X)

 S X=$P($G(DIKZ(12)),U,11)

 I X'="" D KAPTLD^TIUDD01(1211,X)

 S DIKZ(13)=$G(^TIU(8925,DA,13))

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AAU",+$P(^TIU(8925,+DA,12),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,8),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+$P(^TIU(8925,+DA,12),U,8),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+$P(^TIU(8925,+DA,14),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+$P(^TIU(8925,+DA,13),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALL","ANY",+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),$L($P($G(^TIU(8925,+DA,17)),U)) D ASUBK^TIUDD($P($G(^TIU(8925,+DA,17)),U),+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASVC",+$P(^TIU(8925,+DA,14),U,4),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$O(^TIU(8925.9,"B",+DA,0)) D APRBK^TIUDD(+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,3),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U,4),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ADCPT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U,4),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" K ^TIU(8925,"D",$E(X,1,30),DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,5),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALOC",+$P(^TIU(8925,+DA,12),U,5),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" D KACLPT^TIUDD01(1301,X)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" D KACLAU^TIUDD01(1301,X),KACLAU1^TIUDD01(1301,X)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" D KACLEC^TIUDD01(1301,X)

 S X=$P($G(DIKZ(13)),U,1)

 I X'="" D KACLSB^TIUDD01(1301,X)

 S X=$P($G(DIKZ(13)),U,2)

 I X'="" K ^TIU(8925,"TC",$E(X,1,30),DA)

 S X=$P($G(DIKZ(13)),U,2)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(13)),U,2)

 I X'="" D KACLAU1^TIUDD01(1302,X)

 S X=$P($G(DIKZ(13)),U,4)

 I X'="" K ^TIU(8925,"E",$E(X,1,30),DA)

 S DIKZ(14)=$G(^TIU(8925,DA,14))

 S X=$P($G(DIKZ(14)),U,2)

 I X'="" K ^TIU(8925,"TS",$E(X,1,30),DA)

 S X=$P($G(DIKZ(14)),U,2)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(14)),U,4)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASVC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(14)),U,4)

 I X'="" K ^TIU(8925,"SVC",$E(X,1,30),DA)

 S X=$P($G(DIKZ(14)),U,5)

 I X'="" K ^TIU(8925,"G",$E(X,1,30),DA)

 S DIKZ(15)=$G(^TIU(8925,DA,15))

 S X=$P($G(DIKZ(15)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,5) K ^TIU(8925,"ALOCP",+$P($G(^TIU(8925,+DA,12)),U,5),+X,+DA)

 S X=$P($G(DIKZ(15)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTP",+$P($G(^TIU(8925,+DA,0)),U,2),+X,+DA)

 S X=$P($G(DIKZ(15)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,2) K ^TIU(8925,"AAUP",+$P($G(^TIU(8925,+DA,12)),U,2),+X,+DA)

 S X=$P($G(DIKZ(15)),U,1)

 I X'="" D KACLPT^TIUDD01(1501,X)

 S X=$P($G(DIKZ(15)),U,1)

 I X'="" D KACLEC^TIUDD01(1501,X)

 S X=$P($G(DIKZ(15)),U,1)

 I X'="" D SACLAU^TIUDD0(1501,X),SACLAU1^TIUDD0(1501,X)

 S X=$P($G(DIKZ(15)),U,2)

 I X'="" D KACLSB^TIUDD01(1502,X)

 S X=$P($G(DIKZ(15)),U,7)

 I X'="" D SACLEC^TIUDD0(1507,X)

 S X=$P($G(DIKZ(15)),U,7)

 I X'="" D KACLPT^TIUDD01(1507,X)

 S DIKZ(17)=$G(^TIU(8925,DA,17))

 S X=$P($G(DIKZ(17)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$P($G(^TIU(8925,+DA,13)),U) D ASUBK^TIUDD($G(X),+$G(^TIU(8925,+DA,0)),+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)

 S DIKZ(21)=$G(^TIU(8925,DA,21))

 S X=$P($G(DIKZ(21)),U,1)

 I X'="" K ^TIU(8925,"GDAD",$E(X,1,30),DA)

 S DIKZ(150)=$G(^TIU(8925,DA,150))

 S X=$P($G(DIKZ(150)),U,1)

 I X'="" K ^TIU(8925,"VID",$E(X,1,30),DA)

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" K ^TIU(8925,"B",$E(X,1,30),DA)

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I +$P(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AAU",+$P($G(^TIU(8925,+DA,12)),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,8),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+$P($G(^TIU(8925,+DA,12)),U,8),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^(0)),U,3) K ^TIU(8925,"AV",+$P(^TIU(8925,+DA,0),U,2),+X,+$P(^TIU(8925,+DA,0),U,3),+DA)

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+$P($G(^TIU(8925,+DA,14)),U,2),+X,+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I +$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+$P($G(^TIU(8925,+DA,13)),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=$P($G(DIKZ(0)),U,1)

END G ^TIUXRC3

TIUXRC2   ; COMPILED XREF FOR FILE #8925 ; 09/22/15

 +1       ; 

 +2        IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,13)),U)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ASUP",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)

 +3        SET X=$PIECE($GET(DIKZ(12)),U,8)

 +4        IF X'=""

               DO KACLEC^TIUDD01(1208,X)

 +5        SET X=$PIECE($GET(DIKZ(12)),U,11)

 +6        IF X'=""

               DO KAPTLD^TIUDD01(1211,X)

 +7        SET DIKZ(13)=$GET(^TIU(8925,DA,13))

 +8        SET X=$PIECE($GET(DIKZ(13)),U,1)

 +9        IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,12)),U,2)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"AAU",+$PIECE(^TIU(8925,+DA,12),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +10       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +11       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,12)),U,8)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ASUP",+$PIECE(^TIU(8925,+DA,12),U,8),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +12       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +13       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"APT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +14       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +15       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,14)),U,2)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ATS",+$PIECE(^TIU(8925,+DA,14),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +16       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +17       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,13)),U,2)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ATC",+$PIECE(^TIU(8925,+DA,13),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +18       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +19       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                       KILL ^TIU(8925,"ALL","ANY",+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +20       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +21       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                       IF $LENGTH($PIECE($GET(^TIU(8925,+DA,17)),U))

                           DO ASUBK^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 +22       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +23       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,14)),U,4)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ASVC",+$PIECE(^TIU(8925,+DA,14),U,4),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +24       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +25       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                       IF +$ORDER(^TIU(8925.9,"B",+DA,0))

                           DO APRBK^TIUDD(+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 +26       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +27       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,3)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"AVSIT",+$PIECE(^TIU(8925,+DA,0),U,3),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),DA)

 +28       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +29       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U,4)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ADCPT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U,4),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),DA)

 +30       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +31       IF X'=""

               KILL ^TIU(8925,"D",$EXTRACT(X,1,30),DA)

 +32       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +33       IF X'=""

               IF +$PIECE(^TIU(8925,+DA,0),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)

                       KILL ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$PIECE(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)

 +34       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +35       IF X'=""

               IF +$PIECE(^TIU(8925,+DA,0),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)

                       KILL ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)

 +36       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +37       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,12)),U,5)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ALOC",+$PIECE(^TIU(8925,+DA,12),U,5),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)

 +38       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +39       IF X'=""

               DO KACLPT^TIUDD01(1301,X)

 +40       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +41       IF X'=""

               DO KACLAU^TIUDD01(1301,X)

               DO KACLAU1^TIUDD01(1301,X)

 +42       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +43       IF X'=""

               DO KACLEC^TIUDD01(1301,X)

 +44       SET X=$PIECE($GET(DIKZ(13)),U,1)

 +45       IF X'=""

               DO KACLSB^TIUDD01(1301,X)

 +46       SET X=$PIECE($GET(DIKZ(13)),U,2)

 +47       IF X'=""

               KILL ^TIU(8925,"TC",$EXTRACT(X,1,30),DA)

 +48       SET X=$PIECE($GET(DIKZ(13)),U,2)

 +49       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,13)),U)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ATC",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)

 +50       SET X=$PIECE($GET(DIKZ(13)),U,2)

 +51       IF X'=""

               DO KACLAU1^TIUDD01(1302,X)

 +52       SET X=$PIECE($GET(DIKZ(13)),U,4)

 +53       IF X'=""

               KILL ^TIU(8925,"E",$EXTRACT(X,1,30),DA)

 +54       SET DIKZ(14)=$GET(^TIU(8925,DA,14))

 +55       SET X=$PIECE($GET(DIKZ(14)),U,2)

 +56       IF X'=""

               KILL ^TIU(8925,"TS",$EXTRACT(X,1,30),DA)

 +57       SET X=$PIECE($GET(DIKZ(14)),U,2)

 +58       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,13)),U)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ATS",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)

 +59       SET X=$PIECE($GET(DIKZ(14)),U,4)

 +60       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,13)),U)

                       IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                           KILL ^TIU(8925,"ASVC",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)

 +61       SET X=$PIECE($GET(DIKZ(14)),U,4)

 +62       IF X'=""

               KILL ^TIU(8925,"SVC",$EXTRACT(X,1,30),DA)

 +63       SET X=$PIECE($GET(DIKZ(14)),U,5)

 +64       IF X'=""

               KILL ^TIU(8925,"G",$EXTRACT(X,1,30),DA)

 +65       SET DIKZ(15)=$GET(^TIU(8925,DA,15))

 +66       SET X=$PIECE($GET(DIKZ(15)),U,1)

 +67       IF X'=""

               IF +$PIECE($GET(^TIU(8925,+DA,12)),U,5)

                   KILL ^TIU(8925,"ALOCP",+$PIECE($GET(^TIU(8925,+DA,12)),U,5),+X,+DA)