ACRCTV1 ; COMPILED XREF FOR FILE #9002193.5 ; 09/30/09
;
S DIKZK=2
S DIKZ(0)=$G(^ACRTV(DA,0))
S X=$P(DIKZ(0),U,3)
I X'="" K ^ACRTV("D",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,7)
I X'="" K ^ACRTV("C",$E(X,1,30),DA)
S DIKZ("DT")=$G(^ACRTV(DA,"DT"))
S X=$P(DIKZ("DT"),U,1)
I X'="" K ^ACRTV("E",$E(X,1,30),DA)
S X=$P(DIKZ("DT"),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,2,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(9002193.5,2,1,1,2.1) X ^DD(9002193.5,2,1,1,2.4)
S DIKZ("DT")=$G(^ACRTV(DA,"DT"))
S X=$P(DIKZ("DT"),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,3,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y X ^DD(9002193.5,3,1,1,2.1) X ^DD(9002193.5,3,1,1,2.4)
S X=$P(DIKZ("DT"),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,3,1,2,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(9002193.5,3,1,2,2.1) X ^DD(9002193.5,3,1,2,2.4)
S DIKZ("DT")=$G(^ACRTV(DA,"DT"))
S X=$P(DIKZ("DT"),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,13,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"RCJ")):^("RCJ"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(9002193.5,13,1,1,2.4)
S X=$P(DIKZ("DT"),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,13,1,2,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"RCJ")):^("RCJ"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(9002193.5,13,1,2,2.4)
S X=$P(DIKZ("DT"),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,13,1,3,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"RCJ")):^("RCJ"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(9002193.5,13,1,3,2.4)
S X=$P(DIKZ("DT"),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,13,1,4,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"RCJ")):^("RCJ"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(9002193.5,13,1,4,2.4)
S X=$P(DIKZ("DT"),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,13,1,5,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"RCJ")):^("RCJ"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X="" X ^DD(9002193.5,13,1,5,2.4)
S X=$P(DIKZ("DT"),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,13,1,6,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" X ^DD(9002193.5,13,1,6,2.4)
S X=$P(DIKZ("DT"),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002193.5,13,1,7,2.3) I X S X=DIV S Y(1)=$S($D(^ACRTV(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X="" X ^DD(9002193.5,13,1,7,2.4)
S DIKZ(0)=$G(^ACRTV(DA,0))
S X=$P(DIKZ(0),U,1)
I X'="" K ^ACRTV("B",$E(X,1,30),DA)
END Q
ACRCTV1 ; COMPILED XREF FOR FILE #9002193.5 ; 09/30/09
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^ACRTV(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,3)
+5 IF X'=""
KILL ^ACRTV("D",$EXTRACT(X,1,30),DA)
+6 SET X=$PIECE(DIKZ(0),U,7)
+7 IF X'=""
KILL ^ACRTV("C",$EXTRACT(X,1,30),DA)
+8 SET DIKZ("DT")=$GET(^ACRTV(DA,"DT"))
+9 SET X=$PIECE(DIKZ("DT"),U,1)
+10 IF X'=""
KILL ^ACRTV("E",$EXTRACT(X,1,30),DA)
+11 SET X=$PIECE(DIKZ("DT"),U,2)
+12 IF X'=""
Begin DoDot:1
+13 NEW DIK,DIV,DIU,DIN
+14 XECUTE ^DD(9002193.5,2,1,1,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193.5,2,1,1,2.1)
XECUTE ^DD(9002193.5,2,1,1,2.4)
End DoDot:1
+15 SET DIKZ("DT")=$GET(^ACRTV(DA,"DT"))
+16 SET X=$PIECE(DIKZ("DT"),U,3)
+17 IF X'=""
Begin DoDot:1
+18 NEW DIK,DIV,DIU,DIN
+19 XECUTE ^DD(9002193.5,3,1,1,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,6)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193.5,3,1,1,2.1)
XECUTE ^DD(9002193.5,3,1,1,2.4)
End DoDot:1
+20 SET X=$PIECE(DIKZ("DT"),U,3)
+21 IF X'=""
Begin DoDot:1
+22 NEW DIK,DIV,DIU,DIN
+23 XECUTE ^DD(9002193.5,3,1,2,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193.5,3,1,2,2.1)
XECUTE ^DD(9002193.5,3,1,2,2.4)
End DoDot:1
+24 SET DIKZ("DT")=$GET(^ACRTV(DA,"DT"))
+25 SET X=$PIECE(DIKZ("DT"),U,13)
+26 IF X'=""
Begin DoDot:1
+27 NEW DIK,DIV,DIU,DIN
+28 XECUTE ^DD(9002193.5,13,1,1,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"RCJ")):^("RCJ"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002193.5,13,1,1,2.4)
End DoDot:1
+29 SET X=$PIECE(DIKZ("DT"),U,13)
+30 IF X'=""
Begin DoDot:1
+31 NEW DIK,DIV,DIU,DIN
+32 XECUTE ^DD(9002193.5,13,1,2,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"RCJ")):^("RCJ"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002193.5,13,1,2,2.4)
End DoDot:1
+33 SET X=$PIECE(DIKZ("DT"),U,13)
+34 IF X'=""
Begin DoDot:1
+35 NEW DIK,DIV,DIU,DIN
+36 XECUTE ^DD(9002193.5,13,1,3,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"RCJ")):^("RCJ"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002193.5,13,1,3,2.4)
End DoDot:1
+37 SET X=$PIECE(DIKZ("DT"),U,13)
+38 IF X'=""
Begin DoDot:1
+39 NEW DIK,DIV,DIU,DIN
+40 XECUTE ^DD(9002193.5,13,1,4,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"RCJ")):^("RCJ"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002193.5,13,1,4,2.4)
End DoDot:1
+41 SET X=$PIECE(DIKZ("DT"),U,13)
+42 IF X'=""
Begin DoDot:1
+43 NEW DIK,DIV,DIU,DIN
+44 XECUTE ^DD(9002193.5,13,1,5,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"RCJ")):^("RCJ"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002193.5,13,1,5,2.4)
End DoDot:1
+45 SET X=$PIECE(DIKZ("DT"),U,13)
+46 IF X'=""
Begin DoDot:1
+47 NEW DIK,DIV,DIU,DIN
+48 XECUTE ^DD(9002193.5,13,1,6,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,15)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002193.5,13,1,6,2.4)
End DoDot:1
+49 SET X=$PIECE(DIKZ("DT"),U,13)
+50 IF X'=""
Begin DoDot:1
+51 NEW DIK,DIV,DIU,DIN
+52 XECUTE ^DD(9002193.5,13,1,7,2.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRTV(D0,"DT")):^("DT"),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002193.5,13,1,7,2.4)
End DoDot:1
+53 SET DIKZ(0)=$GET(^ACRTV(DA,0))
+54 SET X=$PIECE(DIKZ(0),U,1)
+55 IF X'=""
KILL ^ACRTV("B",$EXTRACT(X,1,30),DA)
END QUIT
