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)
+68 SET X=$PIECE($GET(DIKZ(15)),U,1)
+69 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
KILL ^TIU(8925,"APTP",+$PIECE($GET(^TIU(8925,+DA,0)),U,2),+X,+DA)
+70 SET X=$PIECE($GET(DIKZ(15)),U,1)
+71 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,2)
KILL ^TIU(8925,"AAUP",+$PIECE($GET(^TIU(8925,+DA,12)),U,2),+X,+DA)
+72 SET X=$PIECE($GET(DIKZ(15)),U,1)
+73 IF X'=""
DO KACLPT^TIUDD01(1501,X)
+74 SET X=$PIECE($GET(DIKZ(15)),U,1)
+75 IF X'=""
DO KACLEC^TIUDD01(1501,X)
+76 SET X=$PIECE($GET(DIKZ(15)),U,1)
+77 IF X'=""
DO SACLAU^TIUDD0(1501,X)
DO SACLAU1^TIUDD0(1501,X)
+78 SET X=$PIECE($GET(DIKZ(15)),U,2)
+79 IF X'=""
DO KACLSB^TIUDD01(1502,X)
+80 SET X=$PIECE($GET(DIKZ(15)),U,7)
+81 IF X'=""
DO SACLEC^TIUDD0(1507,X)
+82 SET X=$PIECE($GET(DIKZ(15)),U,7)
+83 IF X'=""
DO KACLPT^TIUDD01(1507,X)
+84 SET DIKZ(17)=$GET(^TIU(8925,DA,17))
+85 SET X=$PIECE($GET(DIKZ(17)),U,1)
+86 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
DO ASUBK^TIUDD($GET(X),+$GET(^TIU(8925,+DA,0)),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+87 SET DIKZ(21)=$GET(^TIU(8925,DA,21))
+88 SET X=$PIECE($GET(DIKZ(21)),U,1)
+89 IF X'=""
KILL ^TIU(8925,"GDAD",$EXTRACT(X,1,30),DA)
+90 SET DIKZ(150)=$GET(^TIU(8925,DA,150))
+91 SET X=$PIECE($GET(DIKZ(150)),U,1)
+92 IF X'=""
KILL ^TIU(8925,"VID",$EXTRACT(X,1,30),DA)
+93 SET X=$PIECE($GET(DIKZ(0)),U,1)
+94 IF X'=""
KILL ^TIU(8925,"B",$EXTRACT(X,1,30),DA)
+95 SET X=$PIECE($GET(DIKZ(0)),U,1)
+96 IF X'=""
IF +$PIECE(^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,"APT",+$PIECE(^TIU(8925,+DA,0),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+97 SET X=$PIECE($GET(DIKZ(0)),U,1)
+98 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"AAU",+$PIECE($GET(^TIU(8925,+DA,12)),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+99 SET X=$PIECE($GET(DIKZ(0)),U,1)
+100 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,8)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASUP",+$PIECE($GET(^TIU(8925,+DA,12)),U,8),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+101 SET X=$PIECE($GET(DIKZ(0)),U,1)
+102 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^(0)),U,3)
KILL ^TIU(8925,"AV",+$PIECE(^TIU(8925,+DA,0),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,3),+DA)
+103 SET X=$PIECE($GET(DIKZ(0)),U,1)
+104 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATS",+$PIECE($GET(^TIU(8925,+DA,14)),U,2),+X,+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+105 SET X=$PIECE($GET(DIKZ(0)),U,1)
+106 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,13)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATC",+$PIECE($GET(^TIU(8925,+DA,13)),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+107 SET X=$PIECE($GET(DIKZ(0)),U,1)
END GOTO ^TIUXRC3
