TIUXRC1.m

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

 ; 

 S DIKZK=2

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

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

 I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AA",+X,+^TIU(8925,+DA,0),(9999999-$P(+^AUPNVSIT($P(^TIU(8925,+DA,0),U,3),0),".")),+DA)

 S X=$P($G(DIKZ(0)),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,"APT",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)

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

 I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AE",+X,(9999999-$P(+^AUPNVSIT($P(^TIU(8925,+DA,0),U,3),0),".")),+^TIU(8925,+DA,0),+DA)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 I X'="" D AIHS1K^BTIUXREF

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

 I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,2)>0) K ^TIU(8925,"AA",$P(^(0),U,2),+$P(^(0),U),(9999999-$P(+$G(^AUPNVSIT(X,0)),".")),DA)

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

 I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,2)>0) K ^TIU(8925,"AE",+$P(^TIU(8925,+DA,0),U,2),(9999999-$P(+$G(^AUPNVSIT(+X,0)),".")),+^TIU(8925,+DA,0),+DA)

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

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

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

 I X'="" ;D:$D(^AUPNVSIT(+X)) SUB^AUPNVSIT

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

 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,"AVSIT",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)

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

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

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

 I X'="" D

 .N DIK,DIV,DIU,DIN

 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^TIU(8925,D0,150)):^(150),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(8925,.03,1,7,2.4)

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

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

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

 I X'="" D AIHS11K^BTIUXREF

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

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

 I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ADCPT",+$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,5)

 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),+X,(9999999-+$P(^TIU(8925,+DA,13),U)),+DA)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 I X'="" D AIHS13K^BTIUXREF

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

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

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

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

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

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

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

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

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

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

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

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

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

 S X=$P($G(DIKZ(12)),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,"AAU",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),+DA)

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

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

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

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

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

 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,"ALOC",+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(12)),U,5)

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

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

 I X'="" ;D:$D(^AUPNVSIT(+X)) SUB^AUPNVSIT

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

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

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

END G ^TIUXRC2

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

 +1       ; 

 +2        SET DIKZK=2

 +3        SET DIKZ(0)=$GET(^TIU(8925,DA,0))

 +4        SET X=$PIECE($GET(DIKZ(0)),U,2)

 +5        IF X'=""

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

                   IF (+$PIECE(^(0),U,3)>0)

                       KILL ^TIU(8925,"AA",+X,+^TIU(8925,+DA,0),(9999999-$PIECE(+^AUPNVSIT($PIECE(^TIU(8925,+DA,0),U,3),0),".")),+DA)

 +6        SET X=$PIECE($GET(DIKZ(0)),U,2)

 +7        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,"APT",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)

 +8        SET X=$PIECE($GET(DIKZ(0)),U,2)

 +9        IF X'=""

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

                   IF (+$PIECE(^(0),U,3)>0)

                       KILL ^TIU(8925,"AE",+X,(9999999-$PIECE(+^AUPNVSIT($PIECE(^TIU(8925,+DA,0),U,3),0),".")),+^TIU(8925,+DA,0),+DA)

 +10       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +11       IF X'=""

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

 +12       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +13       IF X'=""

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

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

                       KILL ^TIU(8925,"AV",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,3),+DA)

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

 +15       IF X'=""

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

                   KILL ^TIU(8925,"APTP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)

 +16       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +17       IF X'=""

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

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

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

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

 +18       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +19       IF X'=""

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

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

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

 +20       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +21       IF X'=""

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

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

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

 +22       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +23       IF X'=""

               DO KACLPT^TIUDD01(.02,X)

 +24       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +25       IF X'=""

               DO KACLAU^TIUDD01(.02,X)

               DO KACLAU1^TIUDD01(.02,X)

 +26       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +27       IF X'=""

               DO KACLEC^TIUDD01(.02,X)

 +28       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +29       IF X'=""

               DO KACLSB^TIUDD01(.02,X)

 +30       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +31       IF X'=""

               DO KAPTLD^TIUDD01(.02,X)

 +32       SET X=$PIECE($GET(DIKZ(0)),U,2)

 +33       IF X'=""

               DO AIHS1K^BTIUXREF

 +34       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +35       IF X'=""

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

                   IF (+$PIECE(^(0),U,2)>0)

                       KILL ^TIU(8925,"AA",$PIECE(^(0),U,2),+$PIECE(^(0),U),(9999999-$PIECE(+$GET(^AUPNVSIT(X,0)),".")),DA)

 +36       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +37       IF X'=""

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

                   IF (+$PIECE(^(0),U,2)>0)

                       KILL ^TIU(8925,"AE",+$PIECE(^TIU(8925,+DA,0),U,2),(9999999-$PIECE(+$GET(^AUPNVSIT(+X,0)),".")),+^TIU(8925,+DA,0),+DA)

 +38       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +39       IF X'=""

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

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

                       KILL ^TIU(8925,"AV",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U),+X,+DA)

 +40       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +41      ;D:$D(^AUPNVSIT(+X)) SUB^AUPNVSIT

           IF X'=""

 +42       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +43       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,"AVSIT",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)

 +44       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +45       IF X'=""

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

 +46       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +47       IF X'=""

               Begin DoDot:1

 +48               NEW DIK,DIV,DIU,DIN

 +49               KILL DIV

                   SET DIV=X

                   SET D0=DA

                   SET DIV(0)=D0

                   SET Y(1)=$SELECT($DATA(^TIU(8925,D0,150)):^(150),1:"")

                   SET X=$PIECE(Y(1),U,1)

                   SET X=X

                   SET DIU=X

                   KILL Y

                   SET X=""

                   XECUTE ^DD(8925,.03,1,7,2.4)

               End DoDot:1

 +50       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +51       IF X'=""

               DO KAPTLD^TIUDD01(.03,X)

 +52       SET X=$PIECE($GET(DIKZ(0)),U,3)

 +53       IF X'=""

               DO AIHS11K^BTIUXREF

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

 +55       SET X=$PIECE($GET(DIKZ(0)),U,4)

 +56       IF X'=""

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

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

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

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

 +57       SET X=$PIECE($GET(DIKZ(0)),U,5)

 +58       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),+X,(9999999-+$PIECE(^TIU(8925,+DA,13),U)),+DA)

 +59       SET X=$PIECE($GET(DIKZ(0)),U,5)

 +60       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,13)),U)

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

 +61       SET X=$PIECE($GET(DIKZ(0)),U,5)

 +62       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,13)),U)

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

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

 +64       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,13)),U)

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

 +65       SET X=$PIECE($GET(DIKZ(0)),U,5)

 +66       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,13)),U)

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

 +67       SET X=$PIECE($GET(DIKZ(0)),U,5)

 +68       IF X'=""

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

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

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

 +69       SET X=$PIECE($GET(DIKZ(0)),U,5)

 +70       IF X'=""

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

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

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

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

 +71       SET X=$PIECE($GET(DIKZ(0)),U,5)