TIUXRC4 ; COMPILED XREF FOR FILE #8925 ; 09/22/15
;
S DIKZK=1
S DIKZ(0)=$G(^TIU(8925,DA,0))
S X=$P($G(DIKZ(0)),U,1)
I X'="" S ^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) S ^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) S ^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) S ^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($$DOCTYPE^TIULF(+DA),U)="DOC",+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^(0)),U,3) S ^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) S ^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) S ^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)
I X'="" I +$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ALL","ANY",+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($$DOCTYPE^TIULF(+DA),U)="DOC",$L($P(^TIU(8925,+DA,0),U,2)),(+$P(^(0),U,3)>0) S ^TIU(8925,"AA",+$P(^(0),U,2),+X,(9999999-$P(+^AUPNVSIT(+$P(^TIU(8925,+DA,0),U,3),0),".")),DA)=""
S X=$P($G(DIKZ(0)),U,1)
I X'="" I $L($P($G(^TIU(8925,+DA,17)),U)),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) D ASUBS^TIUDD($P($G(^TIU(8925,+DA,17)),U),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ASVC",+$P($G(^TIU(8925,+DA,14)),U,4),+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($$DOCTYPE^TIULF(+DA),U)="DOC",+$P($G(^TIU(8925,+DA,0)),U,2),(+$P($G(^(0)),U,3)>0) S ^TIU(8925,"AE",+$P($G(^TIU(8925,+DA,0)),U,2),(9999999-$P(+^AUPNVSIT(+$P(^TIU(8925,+DA,0),U,3),0),".")),+X,+DA)=""
S X=$P($G(DIKZ(0)),U,1)
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,5) S ^TIU(8925,"ALOC",+$P($G(^TIU(8925,+DA,12)),U,5),+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),+$P($G(^TIU(8925,+DA,0)),U,5),+$O(^TIU(8925.9,"B",+DA,0)) D APRBS^TIUDD(+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P(^TIU(8925,+DA,0),U,3),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+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(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U) S ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+X,+DA),(9999999-$P(^TIU(8925,+DA,13),U)),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) S ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-$P(^TIU(8925,+DA,13),U)),DA)=""
S X=$P($G(DIKZ(0)),U,1)
I X'="" D SACLPT^TIUDD0(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D SACLAU^TIUDD0(.01,X),SACLAU1^TIUDD0(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D SACLEC^TIUDD0(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D SACLSB^TIUDD0(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D SAPTLD^TIUDD0(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D AIHS12A^BTIUXREF
S X=$P($G(DIKZ(0)),U,2)
I X'="" I $P($$DOCTYPE^TIULF(+DA),U)="DOC",$L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) S ^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) S ^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 $P($$DOCTYPE^TIULF(+DA),U)="DOC",$L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) S ^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'="" S ^TIU(8925,"C",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,2)
I X'="" I $P($$DOCTYPE^TIULF(+DA),U)="DOC",+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^(0)),U,3) S ^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 +$$APTP^TIULX(+DA),+$P($G(^TIU(8925,+DA,15)),U) S ^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) S ^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) S ^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) S ^TIU(8925,"APTCL",+X,38,(9999999-$P(^TIU(8925,+DA,13),U)),DA)=""
S X=$P($G(DIKZ(0)),U,2)
I X'="" D SACLPT^TIUDD0(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D SACLAU^TIUDD0(.02,X),SACLAU1^TIUDD0(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D SACLEC^TIUDD0(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D SACLSB^TIUDD0(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D SAPTLD^TIUDD0(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D AIHS1A^BTIUXREF
S X=$P($G(DIKZ(0)),U,3)
I X'="" I $P($$DOCTYPE^TIULF(+DA),U)="DOC",$L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,2)>0) S ^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 $P($$DOCTYPE^TIULF(+DA),U)="DOC",$L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,2)>0) S ^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($$DOCTYPE^TIULF(+DA),U)="DOC",+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^(0)),U,2) S ^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)) ADD^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) S ^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'="" S ^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 X ^DD(8925,.03,1,7,1.1) X ^DD(8925,.03,1,7,1.4)
S X=$P($G(DIKZ(0)),U,3)
I X'="" D SAPTLD^TIUDD0(.03,X)
S X=$P($G(DIKZ(0)),U,3)
I X'="" D AIHS11A^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) S ^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)
END G ^TIUXRC5
TIUXRC4 ; COMPILED XREF FOR FILE #8925 ; 09/22/15
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^TIU(8925,DA,0))
+4 SET X=$PIECE($GET(DIKZ(0)),U,1)
+5 IF X'=""
SET ^TIU(8925,"B",$EXTRACT(X,1,30),DA)=""
+6 SET X=$PIECE($GET(DIKZ(0)),U,1)
+7 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)
SET ^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)=""
+8 SET X=$PIECE($GET(DIKZ(0)),U,1)
+9 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)
SET ^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)=""
+10 SET X=$PIECE($GET(DIKZ(0)),U,1)
+11 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)
SET ^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)=""
+12 SET X=$PIECE($GET(DIKZ(0)),U,1)
+13 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^(0)),U,3)
SET ^TIU(8925,"AV",+$PIECE(^TIU(8925,+DA,0),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,3),+DA)=""
+14 SET X=$PIECE($GET(DIKZ(0)),U,1)
+15 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)
SET ^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)=""
+16 SET X=$PIECE($GET(DIKZ(0)),U,1)
+17 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)
SET ^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)=""
+18 SET X=$PIECE($GET(DIKZ(0)),U,1)
+19 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ^TIU(8925,"ALL","ANY",+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)=""
+20 SET X=$PIECE($GET(DIKZ(0)),U,1)
+21 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U,2))
IF (+$PIECE(^(0),U,3)>0)
SET ^TIU(8925,"AA",+$PIECE(^(0),U,2),+X,(9999999-$PIECE(+^AUPNVSIT(+$PIECE(^TIU(8925,+DA,0),U,3),0),".")),DA)=""
+22 SET X=$PIECE($GET(DIKZ(0)),U,1)
+23 IF X'=""
IF $LENGTH($PIECE($GET(^TIU(8925,+DA,17)),U))
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
DO ASUBS^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+24 SET X=$PIECE($GET(DIKZ(0)),U,1)
+25 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,4)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ^TIU(8925,"ASVC",+$PIECE($GET(^TIU(8925,+DA,14)),U,4),+X,+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)=""
+26 SET X=$PIECE($GET(DIKZ(0)),U,1)
+27 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF (+$PIECE($GET(^(0)),U,3)>0)
SET ^TIU(8925,"AE",+$PIECE($GET(^TIU(8925,+DA,0)),U,2),(9999999-$PIECE(+^AUPNVSIT(+$PIECE(^TIU(8925,+DA,0),U,3),0),".")),+X,+DA)=""
+28 SET X=$PIECE($GET(DIKZ(0)),U,1)
+29 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,5)
SET ^TIU(8925,"ALOC",+$PIECE($GET(^TIU(8925,+DA,12)),U,5),+X,+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)=""
+30 SET X=$PIECE($GET(DIKZ(0)),U,1)
+31 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
IF +$ORDER(^TIU(8925.9,"B",+DA,0))
DO APRBS^TIUDD(+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+32 SET X=$PIECE($GET(DIKZ(0)),U,1)
+33 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U,3)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ^TIU(8925,"AVSIT",+$PIECE(^TIU(8925,+DA,0),U,3),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+34 SET X=$PIECE($GET(DIKZ(0)),U,1)
+35 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
SET ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+X,+DA),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+36 SET X=$PIECE($GET(DIKZ(0)),U,1)
+37 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
SET ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),38,(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+38 SET X=$PIECE($GET(DIKZ(0)),U,1)
+39 IF X'=""
DO SACLPT^TIUDD0(.01,X)
+40 SET X=$PIECE($GET(DIKZ(0)),U,1)
+41 IF X'=""
DO SACLAU^TIUDD0(.01,X)
DO SACLAU1^TIUDD0(.01,X)
+42 SET X=$PIECE($GET(DIKZ(0)),U,1)
+43 IF X'=""
DO SACLEC^TIUDD0(.01,X)
+44 SET X=$PIECE($GET(DIKZ(0)),U,1)
+45 IF X'=""
DO SACLSB^TIUDD0(.01,X)
+46 SET X=$PIECE($GET(DIKZ(0)),U,1)
+47 IF X'=""
DO SAPTLD^TIUDD0(.01,X)
+48 SET X=$PIECE($GET(DIKZ(0)),U,1)
+49 IF X'=""
DO AIHS12A^BTIUXREF
+50 SET X=$PIECE($GET(DIKZ(0)),U,2)
+51 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,3)>0)
SET ^TIU(8925,"AA",+X,+^TIU(8925,+DA,0),(9999999-$PIECE(+^AUPNVSIT($PIECE(^TIU(8925,+DA,0),U,3),0),".")),+DA)=""
+52 SET X=$PIECE($GET(DIKZ(0)),U,2)
+53 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,"APT",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+54 SET X=$PIECE($GET(DIKZ(0)),U,2)
+55 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,3)>0)
SET ^TIU(8925,"AE",+X,(9999999-$PIECE(+^AUPNVSIT($PIECE(^TIU(8925,+DA,0),U,3),0),".")),+^TIU(8925,+DA,0),+DA)=""
+56 SET X=$PIECE($GET(DIKZ(0)),U,2)
+57 IF X'=""
SET ^TIU(8925,"C",$EXTRACT(X,1,30),DA)=""
+58 SET X=$PIECE($GET(DIKZ(0)),U,2)
+59 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^(0)),U,3)
SET ^TIU(8925,"AV",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,3),+DA)=""
+60 SET X=$PIECE($GET(DIKZ(0)),U,2)
+61 IF X'=""
IF +$$APTP^TIULX(+DA)
IF +$PIECE($GET(^TIU(8925,+DA,15)),U)
SET ^TIU(8925,"APTP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)=""
+62 SET X=$PIECE($GET(DIKZ(0)),U,2)
+63 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)
SET ^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)=""
+64 SET X=$PIECE($GET(DIKZ(0)),U,2)
+65 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
SET ^TIU(8925,"APTCL",+X,+$$CLINDOC^TIULC1(+$PIECE(^TIU(8925,+DA,0),U),+DA),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+66 SET X=$PIECE($GET(DIKZ(0)),U,2)
+67 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
SET ^TIU(8925,"APTCL",+X,38,(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+68 SET X=$PIECE($GET(DIKZ(0)),U,2)
+69 IF X'=""
DO SACLPT^TIUDD0(.02,X)
+70 SET X=$PIECE($GET(DIKZ(0)),U,2)
+71 IF X'=""
DO SACLAU^TIUDD0(.02,X)
DO SACLAU1^TIUDD0(.02,X)
+72 SET X=$PIECE($GET(DIKZ(0)),U,2)
+73 IF X'=""
DO SACLEC^TIUDD0(.02,X)
+74 SET X=$PIECE($GET(DIKZ(0)),U,2)
+75 IF X'=""
DO SACLSB^TIUDD0(.02,X)
+76 SET X=$PIECE($GET(DIKZ(0)),U,2)
+77 IF X'=""
DO SAPTLD^TIUDD0(.02,X)
+78 SET X=$PIECE($GET(DIKZ(0)),U,2)
+79 IF X'=""
DO AIHS1A^BTIUXREF
+80 SET X=$PIECE($GET(DIKZ(0)),U,3)
+81 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,2)>0)
SET ^TIU(8925,"AA",$PIECE(^(0),U,2),+$PIECE(^(0),U),(9999999-$PIECE(+$GET(^AUPNVSIT(X,0)),".")),DA)=""
+82 SET X=$PIECE($GET(DIKZ(0)),U,3)
+83 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,2)>0)
SET ^TIU(8925,"AE",+$PIECE(^TIU(8925,+DA,0),U,2),(9999999-$PIECE(+$GET(^AUPNVSIT(+X,0)),".")),+^TIU(8925,+DA,0),+DA)=""
+84 SET X=$PIECE($GET(DIKZ(0)),U,3)
+85 IF X'=""
IF $PIECE($$DOCTYPE^TIULF(+DA),U)="DOC"
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^(0)),U,2)
SET ^TIU(8925,"AV",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U),+X,+DA)=""
+86 SET X=$PIECE($GET(DIKZ(0)),U,3)
+87 ;D:$D(^AUPNVSIT(+X)) ADD^AUPNVSIT
IF X'=""
+88 SET X=$PIECE($GET(DIKZ(0)),U,3)
+89 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,"AVSIT",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)=""
+90 SET X=$PIECE($GET(DIKZ(0)),U,3)
+91 IF X'=""
SET ^TIU(8925,"V",$EXTRACT(X,1,30),DA)=""
+92 SET X=$PIECE($GET(DIKZ(0)),U,3)
+93 IF X'=""
Begin DoDot:1
+94 NEW DIK,DIV,DIU,DIN
+95 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
XECUTE ^DD(8925,.03,1,7,1.1)
XECUTE ^DD(8925,.03,1,7,1.4)
End DoDot:1
+96 SET X=$PIECE($GET(DIKZ(0)),U,3)
+97 IF X'=""
DO SAPTLD^TIUDD0(.03,X)
+98 SET X=$PIECE($GET(DIKZ(0)),U,3)
+99 IF X'=""
DO AIHS11A^BTIUXREF
+100 SET DIKZ(0)=$GET(^TIU(8925,DA,0))
+101 SET X=$PIECE($GET(DIKZ(0)),U,4)
+102 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)
SET ^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)=""
+103 SET X=$PIECE($GET(DIKZ(0)),U,5)
END GOTO ^TIUXRC5
