TIUXRC2 ; COMPILED XREF FOR FILE #8925 ; 05/09/23
;
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'="" S DH=8925,DV=.01,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
CR1 S DIXR=247
K X
S X(1)=$P(DIKZ(12),U,12)
S X(2)=$P(DIKZ(0),U,1)
S X(3)=$P(DIKZ(0),U,5)
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)
CR2 S DIXR=557
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)
CR3 S DIXR=1329
K X
S DIKZ(0)=$G(^TIU(8925,DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,5)
S X(3)=$P(DIKZ(0),U,6)
S X(4)=$P(DIKZ(0),U,7)
S X(5)=$P(DIKZ(0),U,8)
S DIKZ(12)=$G(^TIU(8925,DA,12))
S X(6)=$P(DIKZ(12),U,2)
S X(7)=$P(DIKZ(12),U,5)
S DIKZ(13)=$G(^TIU(8925,DA,13))
S X(8)=$P(DIKZ(13),U,1)
S DIKZ(14)=$G(^TIU(8925,DA,14))
S X(9)=$P(DIKZ(14),U,5)
S DIKZ(17)=$G(^TIU(8925,DA,17))
S X(10)=$P(DIKZ(17),U,1)
S DIKZ(21)=$G(^TIU(8925,DA,21))
S X(11)=$P(DIKZ(21),U,1)
S X(12)=$P(DIKZ(0),U,2)
S X=$G(X(1))
D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5),X2(6),X2(7),X2(8),X2(9),X2(10),X2(11),X2(12))=""
. N DIKXARR M DIKXARR=X S DIKCOND=1
. S X=(X2(1)="")
. S DIKCOND=$G(X) K X M X=DIKXARR
. Q:'DIKCOND
. D DOC^TIUDDX
CR4 S DIXR=1571
K X
S DIKZ(12)=$G(^TIU(8925,DA,12))
S X(1)=$P(DIKZ(12),U,2)
S DIKZ(13)=$G(^TIU(8925,DA,13))
S X(2)=$P(DIKZ(13),U,2)
S X(3)=$P(DIKZ(13),U,1)
S X=$G(X(1))
D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3))=""
. D KAADT^TIUDD01(.X)
CR5 S DIXR=1696
K X
S DIKZ(12)=$G(^TIU(8925,DA,12))
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)
CR6 K X
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUXRC2 3221 printed Dec 13, 2024@02:46:36 Page 2
TIUXRC2 ; COMPILED XREF FOR FILE #8925 ; 05/09/23
+1 ;
+2 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)
+3 SET X=$PIECE($GET(DIKZ(0)),U,1)
+4 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)
+5 SET X=$PIECE($GET(DIKZ(0)),U,1)
+6 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)
+7 SET X=$PIECE($GET(DIKZ(0)),U,1)
+8 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)
+9 SET X=$PIECE($GET(DIKZ(0)),U,1)
+10 IF X'=""
DO KACLPT^TIUDD01(.01,X)
+11 SET X=$PIECE($GET(DIKZ(0)),U,1)
+12 IF X'=""
DO KACLAU^TIUDD01(.01,X)
DO KACLAU1^TIUDD01(.01,X)
+13 SET X=$PIECE($GET(DIKZ(0)),U,1)
+14 IF X'=""
DO KACLEC^TIUDD01(.01,X)
+15 SET X=$PIECE($GET(DIKZ(0)),U,1)
+16 IF X'=""
DO KACLSB^TIUDD01(.01,X)
+17 SET X=$PIECE($GET(DIKZ(0)),U,1)
+18 IF X'=""
DO KAPTLD^TIUDD01(.01,X)
+19 SET X=$PIECE($GET(DIKZ(0)),U,1)
+20 IF X'=""
SET DH=8925
SET DV=.01
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
CR1 SET DIXR=247
+1 KILL X
+2 SET X(1)=$PIECE(DIKZ(12),U,12)
+3 SET X(2)=$PIECE(DIKZ(0),U,1)
+4 SET X(3)=$PIECE(DIKZ(0),U,5)
+5 SET X=$PIECE(DIKZ(13),U,1)
+6 IF $GET(X)]""
SET X=9999999-X
+7 if $DATA(X)#2
SET X(4)=X
+8 SET X=$GET(X(1))
+9 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+10 KILL X1,X2
MERGE X1=X,X2=X
+11 if $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4))=""
+12 KILL ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)
End DoDot:1
CR2 SET DIXR=557
+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
CR3 SET DIXR=1329
+1 KILL X
+2 SET DIKZ(0)=$GET(^TIU(8925,DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,5)
+5 SET X(3)=$PIECE(DIKZ(0),U,6)
+6 SET X(4)=$PIECE(DIKZ(0),U,7)
+7 SET X(5)=$PIECE(DIKZ(0),U,8)
+8 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+9 SET X(6)=$PIECE(DIKZ(12),U,2)
+10 SET X(7)=$PIECE(DIKZ(12),U,5)
+11 SET DIKZ(13)=$GET(^TIU(8925,DA,13))
+12 SET X(8)=$PIECE(DIKZ(13),U,1)
+13 SET DIKZ(14)=$GET(^TIU(8925,DA,14))
+14 SET X(9)=$PIECE(DIKZ(14),U,5)
+15 SET DIKZ(17)=$GET(^TIU(8925,DA,17))
+16 SET X(10)=$PIECE(DIKZ(17),U,1)
+17 SET DIKZ(21)=$GET(^TIU(8925,DA,21))
+18 SET X(11)=$PIECE(DIKZ(21),U,1)
+19 SET X(12)=$PIECE(DIKZ(0),U,2)
+20 SET X=$GET(X(1))
+21 Begin DoDot:1
+22 KILL X1,X2
MERGE X1=X,X2=X
+23 if $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5),X2(6),X2(7),X2(8),X2(9),X2(10),X2(11),X2(12))=""
+24 NEW DIKXARR
MERGE DIKXARR=X
SET DIKCOND=1
+25 SET X=(X2(1)="")
+26 SET DIKCOND=$GET(X)
KILL X
MERGE X=DIKXARR
+27 if 'DIKCOND
QUIT
+28 DO DOC^TIUDDX
End DoDot:1
CR4 SET DIXR=1571
+1 KILL X
+2 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+3 SET X(1)=$PIECE(DIKZ(12),U,2)
+4 SET DIKZ(13)=$GET(^TIU(8925,DA,13))
+5 SET X(2)=$PIECE(DIKZ(13),U,2)
+6 SET X(3)=$PIECE(DIKZ(13),U,1)
+7 SET X=$GET(X(1))
+8 Begin DoDot:1
+9 KILL X1,X2
MERGE X1=X,X2=X
+10 if $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3))=""
+11 DO KAADT^TIUDD01(.X)
End DoDot:1
CR5 SET DIXR=1696
+1 KILL X
+2 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+3 SET X(1)=$PIECE(DIKZ(12),U,7)
+4 SET X=$GET(X(1))
+5 IF $GET(X(1))]""
Begin DoDot:1
+6 KILL X1,X2
MERGE X1=X,X2=X
+7 if $DATA(DIKIL)
SET (X2,X2(1))=""
+8 KILL ^TIU(8925,"VS",X,DA)
End DoDot:1
CR6 KILL X
END QUIT
