ACRCD16 ; COMPILED XREF FOR FILE #9002196.0111 ; 09/30/09
;
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002196,148181,1,1,1.1) X ^DD(9002196,148181,1,1,1.4)
S X=$P(DIKZ("TRNG3"),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(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(9002196,148181,1,2,1.1) X ^DD(9002196,148181,1,2,1.4)
S X=$P(DIKZ("TRNG3"),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(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(9002196,148181,1,3,1.1) X ^DD(9002196,148181,1,3,1.4)
S X=$P(DIKZ("TRNG3"),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(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(9002196,148181,1,4,1.1) X ^DD(9002196,148181,1,4,1.4)
S X=$P(DIKZ("TRNG3"),U,1)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002196,148181,1,5,89.2) S X=$S('$D(^AUTTVNDR(+$P(Y(101),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,148181,1,5,1.4)
S X=$P(DIKZ("TRNG3"),U,1)
I X'="" S ^ACRDOC("I",$E(X,1,30),DA)=""
S DIKZ("TRNG")=$G(^ACRDOC(DA,"TRNG"))
S X=$P(DIKZ("TRNG"),U,25)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,148250,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"FA")):^("FA"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,148250,1,1,1.4)
S DIKZ("TRNG4")=$G(^ACRDOC(DA,"TRNG4"))
S X=$P(DIKZ("TRNG4"),U,5)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRDOC(D0,"AU")):^("AU"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,148310,1,1,1.4)
S DIKZ("TRNG4")=$G(^ACRDOC(DA,"TRNG4"))
S X=$P(DIKZ("TRNG4"),U,13)
I X'="" S ^ACRDOC("R",$E(X,1,30),DA)=""
S DIKZ("PR")=$G(^ACRDOC(DA,"PR"))
S X=$P(DIKZ("PR"),U,1)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,999010,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002196,999010,1,1,1.1) X ^DD(9002196,999010,1,1,1.4)
S X=$P(DIKZ("PR"),U,1)
I X'="" S ^ACRDOC("PR",$E(X,1,30),DA)=""
END G ^ACRCD17
ACRCD16 ; COMPILED XREF FOR FILE #9002196.0111 ; 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(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,148181,1,1,1.1)
XECUTE ^DD(9002196,148181,1,1,1.4)
End DoDot:1
+5 SET X=$PIECE(DIKZ("TRNG3"),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(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,148181,1,2,1.1)
XECUTE ^DD(9002196,148181,1,2,1.4)
End DoDot:1
+9 SET X=$PIECE(DIKZ("TRNG3"),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(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,148181,1,3,1.1)
XECUTE ^DD(9002196,148181,1,3,1.4)
End DoDot:1
+13 SET X=$PIECE(DIKZ("TRNG3"),U,1)
+14 IF X'=""
Begin DoDot:1
+15 NEW DIK,DIV,DIU,DIN
+16 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG3")):^("TRNG3"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,148181,1,4,1.1)
XECUTE ^DD(9002196,148181,1,4,1.4)
End DoDot:1
+17 SET X=$PIECE(DIKZ("TRNG3"),U,1)
+18 IF X'=""
Begin DoDot:1
+19 NEW DIK,DIV,DIU,DIN
+20 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002196,148181,1,5,89.2)
SET X=$SELECT('$DATA(^AUTTVNDR(+$PIECE(Y(101),U,1),0)):"",1:$PIECE(^(0),U,1))
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,148181,1,5,1.4)
End DoDot:1
+21 SET X=$PIECE(DIKZ("TRNG3"),U,1)
+22 IF X'=""
SET ^ACRDOC("I",$EXTRACT(X,1,30),DA)=""
+23 SET DIKZ("TRNG")=$GET(^ACRDOC(DA,"TRNG"))
+24 SET X=$PIECE(DIKZ("TRNG"),U,25)
+25 IF X'=""
Begin DoDot:1
+26 NEW DIK,DIV,DIU,DIN
+27 XECUTE ^DD(9002196,148250,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"FA")):^("FA"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,148250,1,1,1.4)
End DoDot:1
+28 SET DIKZ("TRNG4")=$GET(^ACRDOC(DA,"TRNG4"))
+29 SET X=$PIECE(DIKZ("TRNG4"),U,5)
+30 IF X'=""
Begin DoDot:1
+31 NEW DIK,DIV,DIU,DIN
+32 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"AU")):^("AU"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,148310,1,1,1.4)
End DoDot:1
+33 SET DIKZ("TRNG4")=$GET(^ACRDOC(DA,"TRNG4"))
+34 SET X=$PIECE(DIKZ("TRNG4"),U,13)
+35 IF X'=""
SET ^ACRDOC("R",$EXTRACT(X,1,30),DA)=""
+36 SET DIKZ("PR")=$GET(^ACRDOC(DA,"PR"))
+37 SET X=$PIECE(DIKZ("PR"),U,1)
+38 IF X'=""
Begin DoDot:1
+39 NEW DIK,DIV,DIU,DIN
+40 XECUTE ^DD(9002196,999010,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,999010,1,1,1.1)
XECUTE ^DD(9002196,999010,1,1,1.4)
End DoDot:1
+41 SET X=$PIECE(DIKZ("PR"),U,1)
+42 IF X'=""
SET ^ACRDOC("PR",$EXTRACT(X,1,30),DA)=""
END GOTO ^ACRCD17
