TIUXRC5 ; COMPILED XREF FOR FILE #8925 ; 09/22/15
;
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) S ^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) S ^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) S ^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) S ^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) S ^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) S ^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 ASUBS^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) S ^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) S ^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 APRBS^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) S ^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) S ^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 SACLPT^TIUDD0(.05,X)
S X=$P($G(DIKZ(0)),U,5)
I X'="" D SACLEC^TIUDD0(.05,X)
S X=$P($G(DIKZ(0)),U,5)
I X'="" D SACLAU^TIUDD0(.05,X),SACLAU1^TIUDD0(.05,X)
S X=$P($G(DIKZ(0)),U,5)
I X'="" D AIHS13A^BTIUXREF
S X=$P($G(DIKZ(0)),U,6)
I X'="" S ^TIU(8925,"DAD",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,7)
I X'="" D SAPTLD^TIUDD0(.07,X)
S X=$P($G(DIKZ(0)),U,12)
I X'="" S ^TIU(8925,"FIX",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,13)
I X'="" D SAPTLD^TIUDD0(.13,X)
S DIKZ(12)=$G(^TIU(8925,DA,12))
S X=$P($G(DIKZ(12)),U,1)
I X'="" S ^TIU(8925,"F",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(12)),U,2)
I X'="" S ^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) S ^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 +$$AAUP^TIULX(+DA),+$P($G(^TIU(8925,+DA,15)),U) S ^TIU(8925,"AAUP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)=""
S X=$P($G(DIKZ(12)),U,2)
I X'="" D SACLAU^TIUDD0(1202,X)
S X=$P($G(DIKZ(12)),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I '+$$ISDS^TIULX(+$G(^TIU(8925,+DA,0))) I X S X=DIV S Y(1)=$S($D(^TIU(8925,D0,14)):^(14),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(8925,1202,1,5,1.1) X ^DD(8925,1202,1,5,1.4)
S DIKZ(12)=$G(^TIU(8925,DA,12))
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) S ^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 +$$ALOCP^TIULX(+DA),+$P($G(^TIU(8925,+DA,15)),U) S ^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)) ADD^AUPNVSIT
S X=$P($G(DIKZ(12)),U,8)
I X'="" S ^TIU(8925,"CS",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(12)),U,8)
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) S ^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 SACLEC^TIUDD0(1208,X)
S X=$P($G(DIKZ(12)),U,11)
I X'="" D SAPTLD^TIUDD0(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) S ^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) S ^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) S ^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) S ^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) S ^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) S ^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 ASUBS^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) S ^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 APRBS^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) S ^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) S ^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'="" S ^TIU(8925,"D",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(13)),U,1)
END G ^TIUXRC6
TIUXRC5 ; 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,12)),U,8)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ^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)=""
+3 SET X=$PIECE($GET(DIKZ(0)),U,5)
+4 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)
SET ^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)=""
+5 SET X=$PIECE($GET(DIKZ(0)),U,5)
+6 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)
SET ^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)=""
+7 SET X=$PIECE($GET(DIKZ(0)),U,5)
+8 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)
SET ^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)=""
+9 SET X=$PIECE($GET(DIKZ(0)),U,5)
+10 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)
SET ^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)=""
+11 SET X=$PIECE($GET(DIKZ(0)),U,5)
+12 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
SET ^TIU(8925,"ALL","ANY",+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)=""
+13 SET X=$PIECE($GET(DIKZ(0)),U,5)
+14 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 ASUBS^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+$GET(^TIU(8925,+DA,0)),+X,(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+15 SET X=$PIECE($GET(DIKZ(0)),U,5)
+16 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,13)),U)
SET ^TIU(8925,"ASVC",+$PIECE($GET(^TIU(8925,+DA,14)),U,4),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)=""
+17 SET X=$PIECE($GET(DIKZ(0)),U,5)
+18 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,5)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
SET ^TIU(8925,"ALOC",+$PIECE($GET(^TIU(8925,+DA,12)),U,5),+$PIECE($GET(^TIU(8925,+DA,0)),U),+X,(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)=""
+19 SET X=$PIECE($GET(DIKZ(0)),U,5)
+20 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$ORDER(^TIU(8925.9,"B",+DA,0))
DO APRBS^TIUDD(+$GET(^TIU(8925,+DA,0)),+X,(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+21 SET X=$PIECE($GET(DIKZ(0)),U,5)
+22 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,13)),U)
SET ^TIU(8925,"AVSIT",+$PIECE(^TIU(8925,+DA,0),U,3),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)=""
+23 SET X=$PIECE($GET(DIKZ(0)),U,5)
+24 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,4)
SET ^TIU(8925,"ADCPT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U,4),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+25 SET X=$PIECE($GET(DIKZ(0)),U,5)
+26 IF X'=""
DO SACLPT^TIUDD0(.05,X)
+27 SET X=$PIECE($GET(DIKZ(0)),U,5)
+28 IF X'=""
DO SACLEC^TIUDD0(.05,X)
+29 SET X=$PIECE($GET(DIKZ(0)),U,5)
+30 IF X'=""
DO SACLAU^TIUDD0(.05,X)
DO SACLAU1^TIUDD0(.05,X)
+31 SET X=$PIECE($GET(DIKZ(0)),U,5)
+32 IF X'=""
DO AIHS13A^BTIUXREF
+33 SET X=$PIECE($GET(DIKZ(0)),U,6)
+34 IF X'=""
SET ^TIU(8925,"DAD",$EXTRACT(X,1,30),DA)=""
+35 SET X=$PIECE($GET(DIKZ(0)),U,7)
+36 IF X'=""
DO SAPTLD^TIUDD0(.07,X)
+37 SET X=$PIECE($GET(DIKZ(0)),U,12)
+38 IF X'=""
SET ^TIU(8925,"FIX",$EXTRACT(X,1,30),DA)=""
+39 SET X=$PIECE($GET(DIKZ(0)),U,13)
+40 IF X'=""
DO SAPTLD^TIUDD0(.13,X)
+41 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+42 SET X=$PIECE($GET(DIKZ(12)),U,1)
+43 IF X'=""
SET ^TIU(8925,"F",$EXTRACT(X,1,30),DA)=""
+44 SET X=$PIECE($GET(DIKZ(12)),U,2)
+45 IF X'=""
SET ^TIU(8925,"CA",$EXTRACT(X,1,30),DA)=""
+46 SET X=$PIECE($GET(DIKZ(12)),U,2)
+47 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)
SET ^TIU(8925,"AAU",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)=""
+48 SET X=$PIECE($GET(DIKZ(12)),U,2)
+49 IF X'=""
IF +$$AAUP^TIULX(+DA)
IF +$PIECE($GET(^TIU(8925,+DA,15)),U)
SET ^TIU(8925,"AAUP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)=""
+50 SET X=$PIECE($GET(DIKZ(12)),U,2)
+51 IF X'=""
DO SACLAU^TIUDD0(1202,X)
+52 SET X=$PIECE($GET(DIKZ(12)),U,2)
+53 IF X'=""
Begin DoDot:1
+54 NEW DIK,DIV,DIU,DIN
+55 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
IF '+$$ISDS^TIULX(+$GET(^TIU(8925,+DA,0)))
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^TIU(8925,D0,14)):^(14),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(8925,1202,1,5,1.1)
XECUTE ^DD(8925,1202,1,5,1.4)
End DoDot:1
+56 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+57 SET X=$PIECE($GET(DIKZ(12)),U,5)
+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)
SET ^TIU(8925,"ALOC",+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(12)),U,5)
+60 IF X'=""
IF +$$ALOCP^TIULX(+DA)
IF +$PIECE($GET(^TIU(8925,+DA,15)),U)
SET ^TIU(8925,"ALOCP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)=""
+61 SET X=$PIECE($GET(DIKZ(12)),U,7)
+62 ;D:$D(^AUPNVSIT(+X)) ADD^AUPNVSIT
IF X'=""
+63 SET X=$PIECE($GET(DIKZ(12)),U,8)
+64 IF X'=""
SET ^TIU(8925,"CS",$EXTRACT(X,1,30),DA)=""
+65 SET X=$PIECE($GET(DIKZ(12)),U,8)
+66 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)
SET ^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)=""
+67 SET X=$PIECE($GET(DIKZ(12)),U,8)
+68 IF X'=""
DO SACLEC^TIUDD0(1208,X)
+69 SET X=$PIECE($GET(DIKZ(12)),U,11)
+70 IF X'=""
DO SAPTLD^TIUDD0(1211,X)
+71 SET DIKZ(13)=$GET(^TIU(8925,DA,13))
+72 SET X=$PIECE($GET(DIKZ(13)),U,1)
+73 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)
SET ^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)=""
+74 SET X=$PIECE($GET(DIKZ(13)),U,1)
+75 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)
SET ^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)=""
+76 SET X=$PIECE($GET(DIKZ(13)),U,1)
+77 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)
SET ^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)=""
+78 SET X=$PIECE($GET(DIKZ(13)),U,1)
+79 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)
SET ^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)=""
+80 SET X=$PIECE($GET(DIKZ(13)),U,1)
+81 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)
SET ^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)=""
+82 SET X=$PIECE($GET(DIKZ(13)),U,1)
+83 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ^TIU(8925,"ALL","ANY",+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""
+84 SET X=$PIECE($GET(DIKZ(13)),U,1)
+85 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 ASUBS^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
+86 SET X=$PIECE($GET(DIKZ(13)),U,1)
+87 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)
SET ^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)=""
+88 SET X=$PIECE($GET(DIKZ(13)),U,1)
+89 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 APRBS^TIUDD(+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
+90 SET X=$PIECE($GET(DIKZ(13)),U,1)
+91 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)
SET ^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)=""
+92 SET X=$PIECE($GET(DIKZ(13)),U,1)
+93 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)
SET ^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)=""
+94 SET X=$PIECE($GET(DIKZ(13)),U,1)
+95 IF X'=""
SET ^TIU(8925,"D",$EXTRACT(X,1,30),DA)=""
+96 SET X=$PIECE($GET(DIKZ(13)),U,1)
END GOTO ^TIUXRC6
