ACRCSS6 ; COMPILED XREF FOR FILE #9002193.01101 ; 09/30/09
;
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,3)'="" I X S X=DIV S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002193,10,1,1,1.1) X ^DD(9002193,10,1,1,1.4)
S X=$P(DIKZ("DT"),U,1)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002193,10,1,2,1.4)
S X=$P(DIKZ("DT"),U,1)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002193,10,1,3,1.1) X ^DD(9002193,10,1,3,1.4)
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002193,12,1,1,1.1) X ^DD(9002193,12,1,1,1.4)
S X=$P(DIKZ("DT"),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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002193,12,1,2,1.1) X ^DD(9002193,12,1,2,1.4)
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,1,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,1,1.4)
S X=$P(DIKZ("DT"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,2,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,2,1.4)
S X=$P(DIKZ("DT"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,3,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,3,1.4)
S X=$P(DIKZ("DT"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,4,89.2) S X=$P(Y(101),U,1) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,4,1.4)
S X=$P(DIKZ("DT"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193,13,1,5,1.3) I X S X=DIV S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002193,13,1,5,1.4)
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y X ^DD(9002193,15,1,2,1.1) X ^DD(9002193,15,1,2,1.4)
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),U,21)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,1,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,1,1.4)
S X=$P(DIKZ("DT"),U,21)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,2,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,2,1.4)
S X=$P(DIKZ("DT"),U,21)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,3,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,3,1.4)
S X=$P(DIKZ("DT"),U,21)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,4,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,4,1.4)
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),U,19)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,21),X=X S DIU=X K Y X ^DD(9002193,17,1,1,1.1) X ^DD(9002193,17,1,1,1.4)
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=Y(0)'="" I X S X=DIV X ^DD(9002193,18,1,1,89.2) S X=$P(Y(101),U,4) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,1,1.4)
S X=$P(DIKZ("DT"),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,18,1,2,89.2) S X=$P(Y(101),U,5) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,2,1.4)
S X=$P(DIKZ("DT"),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,18,1,3,89.2) S X=$P(Y(101),U,5) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,3,1.4)
S X=$P(DIKZ("DT"),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,18,1,4,89.2) S X=$P(Y(101),U,5) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,4,1.4)
S X=$P(DIKZ("DT"),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002193,18,1,5,1.4)
S DIKZ("VND")=$G(^ACRSS(DA,"VND"))
S X=$P(DIKZ("VND"),U,1)
I X'="" S ^ACRSS("VND",$E(X,1,30),DA)=""
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),U,20)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,21),X=X S DIU=X K Y X ^DD(9002193,32,1,1,1.1) X ^DD(9002193,32,1,1,1.4)
S DIKZ("APV")=$G(^ACRSS(DA,"APV"))
S X=$P(DIKZ("APV"),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193,911,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(9002193,911,1,1,1.1) X ^DD(9002193,911,1,1,1.4)
END G ^ACRCSS7
ACRCSS6 ; COMPILED XREF FOR FILE #9002193.01101 ; 09/30/09
+1 ;
+2 IF X'=""
Begin DoDot:1
+3 NEW DIK,DIV,DIU,DIN
+4 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,3)'=""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,10,1,1,1.1)
XECUTE ^DD(9002193,10,1,1,1.4)
End DoDot:1
+5 SET X=$PIECE(DIKZ("DT"),U,1)
+6 IF X'=""
Begin DoDot:1
+7 NEW DIK,DIV,DIU,DIN
+8 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002193,10,1,2,1.4)
End DoDot:1
+9 SET X=$PIECE(DIKZ("DT"),U,1)
+10 IF X'=""
Begin DoDot:1
+11 NEW DIK,DIV,DIU,DIN
+12 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,10,1,3,1.1)
XECUTE ^DD(9002193,10,1,3,1.4)
End DoDot:1
+13 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+14 SET X=$PIECE(DIKZ("DT"),U,3)
+15 IF X'=""
Begin DoDot:1
+16 NEW DIK,DIV,DIU,DIN
+17 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,12,1,1,1.1)
XECUTE ^DD(9002193,12,1,1,1.4)
End DoDot:1
+18 SET X=$PIECE(DIKZ("DT"),U,3)
+19 IF X'=""
Begin DoDot:1
+20 NEW DIK,DIV,DIU,DIN
+21 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,12,1,2,1.1)
XECUTE ^DD(9002193,12,1,2,1.4)
End DoDot:1
+22 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+23 SET X=$PIECE(DIKZ("DT"),U,4)
+24 IF X'=""
Begin DoDot:1
+25 NEW DIK,DIV,DIU,DIN
+26 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,13,1,1,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,13,1,1,1.4)
End DoDot:1
+27 SET X=$PIECE(DIKZ("DT"),U,4)
+28 IF X'=""
Begin DoDot:1
+29 NEW DIK,DIV,DIU,DIN
+30 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,13,1,2,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,13,1,2,1.4)
End DoDot:1
+31 SET X=$PIECE(DIKZ("DT"),U,4)
+32 IF X'=""
Begin DoDot:1
+33 NEW DIK,DIV,DIU,DIN
+34 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,13,1,3,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,13,1,3,1.4)
End DoDot:1
+35 SET X=$PIECE(DIKZ("DT"),U,4)
+36 IF X'=""
Begin DoDot:1
+37 NEW DIK,DIV,DIU,DIN
+38 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,13,1,4,89.2)
SET X=$PIECE(Y(101),U,1)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,13,1,4,1.4)
End DoDot:1
+39 SET X=$PIECE(DIKZ("DT"),U,4)
+40 IF X'=""
Begin DoDot:1
+41 NEW DIK,DIV,DIU,DIN
+42 XECUTE ^DD(9002193,13,1,5,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002193,13,1,5,1.4)
End DoDot:1
+43 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+44 SET X=$PIECE(DIKZ("DT"),U,6)
+45 IF X'=""
Begin DoDot:1
+46 NEW DIK,DIV,DIU,DIN
+47 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,15,1,2,1.1)
XECUTE ^DD(9002193,15,1,2,1.4)
End DoDot:1
+48 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+49 SET X=$PIECE(DIKZ("DT"),U,21)
+50 IF X'=""
Begin DoDot:1
+51 NEW DIK,DIV,DIU,DIN
+52 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET X=Y(0)'=0
IF X
SET X=DIV
XECUTE ^DD(9002193,16.1,1,1,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,16.1,1,1,1.4)
End DoDot:1
+53 SET X=$PIECE(DIKZ("DT"),U,21)
+54 IF X'=""
Begin DoDot:1
+55 NEW DIK,DIV,DIU,DIN
+56 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET X=Y(0)'=0
IF X
SET X=DIV
XECUTE ^DD(9002193,16.1,1,2,89.2)
SET X=$PIECE(Y(101),U,3)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,16.1,1,2,1.4)
End DoDot:1
+57 SET X=$PIECE(DIKZ("DT"),U,21)
+58 IF X'=""
Begin DoDot:1
+59 NEW DIK,DIV,DIU,DIN
+60 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET X=Y(0)'=0
IF X
SET X=DIV
XECUTE ^DD(9002193,16.1,1,3,89.2)
SET X=$PIECE(Y(101),U,3)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,16.1,1,3,1.4)
End DoDot:1
+61 SET X=$PIECE(DIKZ("DT"),U,21)
+62 IF X'=""
Begin DoDot:1
+63 NEW DIK,DIV,DIU,DIN
+64 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET X=Y(0)'=0
IF X
SET X=DIV
XECUTE ^DD(9002193,16.1,1,4,89.2)
SET X=$PIECE(Y(101),U,3)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,16.1,1,4,1.4)
End DoDot:1
+65 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+66 SET X=$PIECE(DIKZ("DT"),U,19)
+67 IF X'=""
Begin DoDot:1
+68 NEW DIK,DIV,DIU,DIN
+69 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,21)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,17,1,1,1.1)
XECUTE ^DD(9002193,17,1,1,1.4)
End DoDot:1
+70 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+71 SET X=$PIECE(DIKZ("DT"),U,9)
+72 IF X'=""
Begin DoDot:1
+73 NEW DIK,DIV,DIU,DIN
+74 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET X=Y(0)'=""
IF X
SET X=DIV
XECUTE ^DD(9002193,18,1,1,89.2)
SET X=$PIECE(Y(101),U,4)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,18,1,1,1.4)
End DoDot:1
+75 SET X=$PIECE(DIKZ("DT"),U,9)
+76 IF X'=""
Begin DoDot:1
+77 NEW DIK,DIV,DIU,DIN
+78 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,18,1,2,89.2)
SET X=$PIECE(Y(101),U,5)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,18,1,2,1.4)
End DoDot:1
+79 SET X=$PIECE(DIKZ("DT"),U,9)
+80 IF X'=""
Begin DoDot:1
+81 NEW DIK,DIV,DIU,DIN
+82 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,18,1,3,89.2)
SET X=$PIECE(Y(101),U,5)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,18,1,3,1.4)
End DoDot:1
+83 SET X=$PIECE(DIKZ("DT"),U,9)
+84 IF X'=""
Begin DoDot:1
+85 NEW DIK,DIV,DIU,DIN
+86 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,18,1,4,89.2)
SET X=$PIECE(Y(101),U,5)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIU+DIV
XECUTE ^DD(9002193,18,1,4,1.4)
End DoDot:1
+87 SET X=$PIECE(DIKZ("DT"),U,9)
+88 IF X'=""
Begin DoDot:1
+89 NEW DIK,DIV,DIU,DIN
+90 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002193,18,1,5,1.4)
End DoDot:1
+91 SET DIKZ("VND")=$GET(^ACRSS(DA,"VND"))
+92 SET X=$PIECE(DIKZ("VND"),U,1)
+93 IF X'=""
SET ^ACRSS("VND",$EXTRACT(X,1,30),DA)=""
+94 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+95 SET X=$PIECE(DIKZ("DT"),U,20)
+96 IF X'=""
Begin DoDot:1
+97 NEW DIK,DIV,DIU,DIN
+98 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,21)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,32,1,1,1.1)
XECUTE ^DD(9002193,32,1,1,1.4)
End DoDot:1
+99 SET DIKZ("APV")=$GET(^ACRSS(DA,"APV"))
+100 SET X=$PIECE(DIKZ("APV"),U,2)
+101 IF X'=""
Begin DoDot:1
+102 NEW DIK,DIV,DIU,DIN
+103 XECUTE ^DD(9002193,911,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,911,1,1,1.1)
XECUTE ^DD(9002193,911,1,1,1.4)
End DoDot:1
END GOTO ^ACRCSS7
