TIUXRC3 ; COMPILED XREF FOR FILE #8925 ; 09/22/15
;
I X'="" I +$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^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 $L($P(^TIU(8925,+DA,0),U,2)),(+$P(^(0),U,3)>0) K ^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 ASUBK^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) K ^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 $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) K ^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) K ^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 APRBK^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) K ^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) K ^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) K ^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 KACLPT^TIUDD01(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D KACLAU^TIUDD01(.01,X),KACLAU1^TIUDD01(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D KACLEC^TIUDD01(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D KACLSB^TIUDD01(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D KAPTLD^TIUDD01(.01,X)
S X=$P($G(DIKZ(0)),U,1)
I X'="" D AIHS12K^BTIUXREF
CR1 S DIXR=245
K X
S X(1)=$P(DIKZ(12),U,7)
S X=$G(X(1))
I $G(X(1))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1))=""
. K ^TIU(8925,"VS",X,DA)
CR2 S DIXR=307
K X
S DIKZ(12)=$G(^TIU(8925,DA,12))
S X(1)=$P(DIKZ(12),U,12)
S DIKZ(0)=$G(^TIU(8925,DA,0))
S X(2)=$P(DIKZ(0),U,1)
S X(3)=$P(DIKZ(0),U,5)
S DIKZ(13)=$G(^TIU(8925,DA,13))
S X=$P(DIKZ(13),U,1)
I $G(X)]"" S X=9999999-X
S:$D(X)#2 X(4)=X
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4))=""
. K ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)
CR3 S DIXR=578
K X
S DIKZ(12)=$G(^TIU(8925,DA,12))
S X(1)=$P(DIKZ(12),U,1)
S DIKZ(18)=$G(^TIU(8925,DA,18))
S X(2)=$P(DIKZ(18),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. K ^TIU(8925,"VBC",$E(X(1),1,14),$E(X(2),1,6),DA)
CR4 K X
END Q
TIUXRC3 ; COMPILED XREF FOR FILE #8925 ; 09/22/15
+1 ;
+2 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ALL","ANY",+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+3 SET X=$PIECE($GET(DIKZ(0)),U,1)
+4 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U,2))
IF (+$PIECE(^(0),U,3)>0)
KILL ^TIU(8925,"AA",+$PIECE(^(0),U,2),+X,(9999999-$PIECE(+^AUPNVSIT(+$PIECE(^TIU(8925,+DA,0),U,3),0),".")),DA)
+5 SET X=$PIECE($GET(DIKZ(0)),U,1)
+6 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 ASUBK^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+7 SET X=$PIECE($GET(DIKZ(0)),U,1)
+8 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)
KILL ^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)
+9 SET X=$PIECE($GET(DIKZ(0)),U,1)
+10 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,3)>0)
KILL ^TIU(8925,"AE",+$PIECE($GET(^TIU(8925,+DA,0)),U,2),(9999999-$PIECE(+^AUPNVSIT(+$PIECE(^TIU(8925,+DA,0),U,3),0),".")),+X,+DA)
+11 SET X=$PIECE($GET(DIKZ(0)),U,1)
+12 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)
KILL ^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)
+13 SET X=$PIECE($GET(DIKZ(0)),U,1)
+14 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 APRBK^TIUDD(+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+15 SET X=$PIECE($GET(DIKZ(0)),U,1)
+16 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)
KILL ^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)
+17 SET X=$PIECE($GET(DIKZ(0)),U,1)
+18 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+X,+DA),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+19 SET X=$PIECE($GET(DIKZ(0)),U,1)
+20 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),38,(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+21 SET X=$PIECE($GET(DIKZ(0)),U,1)
+22 IF X'=""
DO KACLPT^TIUDD01(.01,X)
+23 SET X=$PIECE($GET(DIKZ(0)),U,1)
+24 IF X'=""
DO KACLAU^TIUDD01(.01,X)
DO KACLAU1^TIUDD01(.01,X)
+25 SET X=$PIECE($GET(DIKZ(0)),U,1)
+26 IF X'=""
DO KACLEC^TIUDD01(.01,X)
+27 SET X=$PIECE($GET(DIKZ(0)),U,1)
+28 IF X'=""
DO KACLSB^TIUDD01(.01,X)
+29 SET X=$PIECE($GET(DIKZ(0)),U,1)
+30 IF X'=""
DO KAPTLD^TIUDD01(.01,X)
+31 SET X=$PIECE($GET(DIKZ(0)),U,1)
+32 IF X'=""
DO AIHS12K^BTIUXREF
CR1 SET DIXR=245
+1 KILL X
+2 SET X(1)=$PIECE(DIKZ(12),U,7)
+3 SET X=$GET(X(1))
+4 IF $GET(X(1))]""
Begin DoDot:1
+5 KILL X1,X2
MERGE X1=X,X2=X
+6 IF $DATA(DIKIL)
SET (X2,X2(1))=""
+7 KILL ^TIU(8925,"VS",X,DA)
End DoDot:1
CR2 SET DIXR=307
+1 KILL X
+2 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+3 SET X(1)=$PIECE(DIKZ(12),U,12)
+4 SET DIKZ(0)=$GET(^TIU(8925,DA,0))
+5 SET X(2)=$PIECE(DIKZ(0),U,1)
+6 SET X(3)=$PIECE(DIKZ(0),U,5)
+7 SET DIKZ(13)=$GET(^TIU(8925,DA,13))
+8 SET X=$PIECE(DIKZ(13),U,1)
+9 IF $GET(X)]""
SET X=9999999-X
+10 IF $DATA(X)#2
SET X(4)=X
+11 SET X=$GET(X(1))
+12 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+13 KILL X1,X2
MERGE X1=X,X2=X
+14 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4))=""
+15 KILL ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)
End DoDot:1
CR3 SET DIXR=578
+1 KILL X
+2 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+3 SET X(1)=$PIECE(DIKZ(12),U,1)
+4 SET DIKZ(18)=$GET(^TIU(8925,DA,18))
+5 SET X(2)=$PIECE(DIKZ(18),U,1)
+6 SET X=$GET(X(1))
+7 IF $GET(X(1))]""
IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+10 KILL ^TIU(8925,"VBC",$EXTRACT(X(1),1,14),$EXTRACT(X(2),1,6),DA)
End DoDot:1
CR4 KILL X
END QUIT
