ACRCD15 ; COMPILED XREF FOR FILE #9002196.0111 ; 09/30/09
;
S X=$P(DIKZ("REQ"),U,10)
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,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y X ^DD(9002196,113100,1,39,1.1) X ^DD(9002196,113100,1,39,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,40,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y X ^DD(9002196,113100,1,40,1.1) X ^DD(9002196,113100,1,40,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,41,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"POIO")):^("POIO"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y X ^DD(9002196,113100,1,41,1.1) X ^DD(9002196,113100,1,41,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,42,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y X ^DD(9002196,113100,1,42,1.1) X ^DD(9002196,113100,1,42,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,43,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002196,113100,1,43,1.1) X ^DD(9002196,113100,1,43,1.4)
S X=$P(DIKZ("REQ"),U,10)
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,"FA")):^("FA"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(9002196,113100,1,44,1.1) X ^DD(9002196,113100,1,44,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,45,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TO")):^("TO"),1:"") S X=$P(Y(1),U,27),X=X S DIU=X K Y X ^DD(9002196,113100,1,45,1.1) X ^DD(9002196,113100,1,45,1.4)
S X=$P(DIKZ("REQ"),U,10)
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,"TRNG4")):^("TRNG4"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y X ^DD(9002196,113100,1,46,1.1) X ^DD(9002196,113100,1,46,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,47,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"PA")):^("PA"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,47,1.1) X ^DD(9002196,113100,1,47,1.4)
S DIKZ("REQ")=$G(^ACRDOC(DA,"REQ"))
S X=$P(DIKZ("REQ"),U,11)
I X'="" I X S X1=X,X2=$P(^ACRDOC(DA,"REQ"),U,5) D ^%DTC S $P(^ACRDOC(DA,"DT"),U,4)=$S(X>29:"R",X>15:"P",1:"E")
S DIKZ("REQ1")=$G(^ACRDOC(DA,"REQ1"))
S X=$P(DIKZ("REQ1"),U,2)
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,"POST")):^("POST"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002196,113122,1,1,1.4)
S DIKZ("REQ1")=$G(^ACRDOC(DA,"REQ1"))
S X=$P(DIKZ("REQ1"),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(^ACRDOC(D0,"POST")):^("POST"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002196,113123,1,1,1.4)
S DIKZ("REQ1")=$G(^ACRDOC(DA,"REQ1"))
S X=$P(DIKZ("REQ1"),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,"POST")):^("POST"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,113125,1,1,1.4)
S DIKZ("REQ1")=$G(^ACRDOC(DA,"REQ1"))
S X=$P(DIKZ("REQ1"),U,8)
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,"POST")):^("POST"),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002196,113126,1,1,1.4)
S DIKZ("REQ2")=$G(^ACRDOC(DA,"REQ2"))
S X=$P(DIKZ("REQ2"),U,13)
I X'="" S ^ACRDOC("PVEN",$E(X,1,30),DA)=""
S DIKZ("TO")=$G(^ACRDOC(DA,"TO"))
S X=$P(DIKZ("TO"),U,20)
I X'="" S ^ACRDOC("K",$E(X,1,30),DA)=""
S X=$P(DIKZ("TO"),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(^ACRDOC(D0,"TO")):^("TO"),1:"") S X=$P(Y(1),U,18),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,130040,1,1,1.4)
S X=$P(DIKZ("TO"),U,9)
I X'="" I $D(DA),DA,$D(^ACRDOC(DA,"TO")),$P(^("TO"),U,9) S ACRDUZ=$P(^("TO"),U,9) I $D(^ACRAU(ACRDUZ,0)),$D(^(1)),+^(1) S $P(^ACRDOC(DA,"TO"),U,13)=+^(1)
S X=$P(DIKZ("TO"),U,9)
I X'="" S ^ACRDOC("N",$E(X,1,30),DA)=""
S X=$P(DIKZ("TO"),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(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(9002196,130040,1,4,1.1) X ^DD(9002196,130040,1,4,1.4)
S DIKZ("TO")=$G(^ACRDOC(DA,"TO"))
S X=$P(DIKZ("TO"),U,12)
I X'="" S ^ACRDOC("TDEPT",$E(X,1,30),DA)=""
S X=$P(DIKZ("TO"),U,14)
I X'="" S ^ACRDOC("DD",$E(X,1,30),DA)=""
S X=$P(DIKZ("TO"),U,19)
I X'="" I $E(X)'="Y" S $P(^ACRDOC(+$G(DA),"TO"),U,25)=""
S X=$P(DIKZ("TO"),U,18)
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,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,130150,1,1,1.4)
S DIKZ("TO")=$G(^ACRDOC(DA,"TO"))
S X=$P(DIKZ("TO"),U,16)
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,"TO")):^("TO"),1:"") S X=$P(Y(1),U,17),X=X S DIU=X K Y X ^DD(9002196,130151,1,1,1.1) X ^DD(9002196,130151,1,1,1.4)
S X=$P(DIKZ("TO"),U,16)
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,"TOAU")):^("TOAU"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,130151,1,2,1.4)
S DIKZ("TOAU")=$G(^ACRDOC(DA,"TOAU"))
S X=$P(DIKZ("TOAU"),U,2)
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,130154,1,1,1.4)
S X=$P(DIKZ("TOAU"),U,2)
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,"TOAU")):^("TOAU"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(9002196,130154,1,2,1.4)
S X=$P(DIKZ("TOAU"),U,2)
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,"TOAU")):^("TOAU"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,130154,1,3,1.1) X ^DD(9002196,130154,1,3,1.4)
S DIKZ("TO")=$G(^ACRDOC(DA,"TO"))
S X=$P(DIKZ("TO"),U,22)
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),X=X S X=X=0 I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X="" X ^DD(9002196,130157,1,1,1.4)
S DIKZ(13)=$G(^ACRDOC(DA,13))
S X=$P(DIKZ(13),U,2)
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,"TO")):^("TO"),1:"") S X=$P(Y(1),U,26),X=X S DIU=X K Y X ^DD(9002196,130172,1,1,1.1) X ^DD(9002196,130172,1,1,1.4)
S DIKZ("TOAU")=$G(^ACRDOC(DA,"TOAU"))
S X=$P(DIKZ("TOAU"),U,8)
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,"TO")):^("TO"),1:"") S X=$P(Y(1),U,26),X=X S DIU=X K Y X ^DD(9002196,130177,1,1,1.1) X ^DD(9002196,130177,1,1,1.4)
S DIKZ("TOAU")=$G(^ACRDOC(DA,"TOAU"))
S X=$P(DIKZ("TOAU"),U,9)
I X'="" S ^ACRDOC("Q",$E(X,1,30),DA)=""
S DIKZ("TRNG")=$G(^ACRDOC(DA,"TRNG"))
S X=$P(DIKZ("TRNG"),U,2)
I X'="" S ^ACRDOC("F",$E(X,1,30),DA)=""
S X=$P(DIKZ("TRNG"),U,2)
I X'="" X ^DD(9002196,148030,1,2,1)
S X=$P(DIKZ("TRNG"),U,2)
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,"TRNG4")):^("TRNG4"),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y X ^DD(9002196,148030,1,3,1.1) X ^DD(9002196,148030,1,3,1.4)
S DIKZ("TRNG")=$G(^ACRDOC(DA,"TRNG"))
S X=$P(DIKZ("TRNG"),U,3)
I X'="" S ^ACRDOC("M",$E(X,1,30),DA)=""
S X=$P(DIKZ("TRNG"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002196,148050,1,1,89.2) S X=$P(Y(101),U,1) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIV X ^DD(9002196,148050,1,1,1.4)
S DIKZ("TRNG3")=$G(^ACRDOC(DA,"TRNG3"))
S X=$P(DIKZ("TRNG3"),U,1)
END G ^ACRCD16
ACRCD15 ; COMPILED XREF FOR FILE #9002196.0111 ; 09/30/09
+1 ;
+2 SET X=$PIECE(DIKZ("REQ"),U,10)
+3 IF X'=""
Begin DoDot:1
+4 NEW DIK,DIV,DIU,DIN
+5 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,39,1.1)
XECUTE ^DD(9002196,113100,1,39,1.4)
End DoDot:1
+6 SET X=$PIECE(DIKZ("REQ"),U,10)
+7 IF X'=""
Begin DoDot:1
+8 NEW DIK,DIV,DIU,DIN
+9 XECUTE ^DD(9002196,113100,1,40,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,40,1.1)
XECUTE ^DD(9002196,113100,1,40,1.4)
End DoDot:1
+10 SET X=$PIECE(DIKZ("REQ"),U,10)
+11 IF X'=""
Begin DoDot:1
+12 NEW DIK,DIV,DIU,DIN
+13 XECUTE ^DD(9002196,113100,1,41,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POIO")):^("POIO"),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,41,1.1)
XECUTE ^DD(9002196,113100,1,41,1.4)
End DoDot:1
+14 SET X=$PIECE(DIKZ("REQ"),U,10)
+15 IF X'=""
Begin DoDot:1
+16 NEW DIK,DIV,DIU,DIN
+17 XECUTE ^DD(9002196,113100,1,42,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,42,1.1)
XECUTE ^DD(9002196,113100,1,42,1.4)
End DoDot:1
+18 SET X=$PIECE(DIKZ("REQ"),U,10)
+19 IF X'=""
Begin DoDot:1
+20 NEW DIK,DIV,DIU,DIN
+21 XECUTE ^DD(9002196,113100,1,43,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,43,1.1)
XECUTE ^DD(9002196,113100,1,43,1.4)
End DoDot:1
+22 SET X=$PIECE(DIKZ("REQ"),U,10)
+23 IF X'=""
Begin DoDot:1
+24 NEW DIK,DIV,DIU,DIN
+25 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"FA")):^("FA"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,44,1.1)
XECUTE ^DD(9002196,113100,1,44,1.4)
End DoDot:1
+26 SET X=$PIECE(DIKZ("REQ"),U,10)
+27 IF X'=""
Begin DoDot:1
+28 NEW DIK,DIV,DIU,DIN
+29 XECUTE ^DD(9002196,113100,1,45,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
SET X=$PIECE(Y(1),U,27)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,45,1.1)
XECUTE ^DD(9002196,113100,1,45,1.4)
End DoDot:1
+30 SET X=$PIECE(DIKZ("REQ"),U,10)
+31 IF X'=""
Begin DoDot:1
+32 NEW DIK,DIV,DIU,DIN
+33 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"")
SET X=$PIECE(Y(1),U,15)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,46,1.1)
XECUTE ^DD(9002196,113100,1,46,1.4)
End DoDot:1
+34 SET X=$PIECE(DIKZ("REQ"),U,10)
+35 IF X'=""
Begin DoDot:1
+36 NEW DIK,DIV,DIU,DIN
+37 XECUTE ^DD(9002196,113100,1,47,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"PA")):^("PA"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,47,1.1)
XECUTE ^DD(9002196,113100,1,47,1.4)
End DoDot:1
+38 SET DIKZ("REQ")=$GET(^ACRDOC(DA,"REQ"))
+39 SET X=$PIECE(DIKZ("REQ"),U,11)
+40 IF X'=""
IF X
SET X1=X
SET X2=$PIECE(^ACRDOC(DA,"REQ"),U,5)
DO ^%DTC
SET $PIECE(^ACRDOC(DA,"DT"),U,4)=$SELECT(X>29:"R",X>15:"P",1:"E")
+41 SET DIKZ("REQ1")=$GET(^ACRDOC(DA,"REQ1"))
+42 SET X=$PIECE(DIKZ("REQ1"),U,2)
+43 IF X'=""
Begin DoDot:1
+44 NEW DIK,DIV,DIU,DIN
+45 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POST")):^("POST"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002196,113122,1,1,1.4)
End DoDot:1
+46 SET DIKZ("REQ1")=$GET(^ACRDOC(DA,"REQ1"))
+47 SET X=$PIECE(DIKZ("REQ1"),U,3)
+48 IF X'=""
Begin DoDot:1
+49 NEW DIK,DIV,DIU,DIN
+50 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POST")):^("POST"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002196,113123,1,1,1.4)
End DoDot:1
+51 SET DIKZ("REQ1")=$GET(^ACRDOC(DA,"REQ1"))
+52 SET X=$PIECE(DIKZ("REQ1"),U,5)
+53 IF X'=""
Begin DoDot:1
+54 NEW DIK,DIV,DIU,DIN
+55 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POST")):^("POST"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,113125,1,1,1.4)
End DoDot:1
+56 SET DIKZ("REQ1")=$GET(^ACRDOC(DA,"REQ1"))
+57 SET X=$PIECE(DIKZ("REQ1"),U,8)
+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(1)=$SELECT($DATA(^ACRDOC(D0,"POST")):^("POST"),1:"")
SET X=$PIECE(Y(1),U,6)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002196,113126,1,1,1.4)
End DoDot:1
+61 SET DIKZ("REQ2")=$GET(^ACRDOC(DA,"REQ2"))
+62 SET X=$PIECE(DIKZ("REQ2"),U,13)
+63 IF X'=""
SET ^ACRDOC("PVEN",$EXTRACT(X,1,30),DA)=""
+64 SET DIKZ("TO")=$GET(^ACRDOC(DA,"TO"))
+65 SET X=$PIECE(DIKZ("TO"),U,20)
+66 IF X'=""
SET ^ACRDOC("K",$EXTRACT(X,1,30),DA)=""
+67 SET X=$PIECE(DIKZ("TO"),U,9)
+68 IF X'=""
Begin DoDot:1
+69 NEW DIK,DIV,DIU,DIN
+70 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
SET X=$PIECE(Y(1),U,18)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,130040,1,1,1.4)
End DoDot:1
+71 SET X=$PIECE(DIKZ("TO"),U,9)
+72 IF X'=""
IF $DATA(DA)
IF DA
IF $DATA(^ACRDOC(DA,"TO"))
IF $PIECE(^("TO"),U,9)
SET ACRDUZ=$PIECE(^("TO"),U,9)
IF $DATA(^ACRAU(ACRDUZ,0))
IF $DATA(^(1))
IF +^(1)
SET $PIECE(^ACRDOC(DA,"TO"),U,13)=+^(1)
+73 SET X=$PIECE(DIKZ("TO"),U,9)
+74 IF X'=""
SET ^ACRDOC("N",$EXTRACT(X,1,30),DA)=""
+75 SET X=$PIECE(DIKZ("TO"),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
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,130040,1,4,1.1)
XECUTE ^DD(9002196,130040,1,4,1.4)
End DoDot:1
+79 SET DIKZ("TO")=$GET(^ACRDOC(DA,"TO"))
+80 SET X=$PIECE(DIKZ("TO"),U,12)
+81 IF X'=""
SET ^ACRDOC("TDEPT",$EXTRACT(X,1,30),DA)=""
+82 SET X=$PIECE(DIKZ("TO"),U,14)
+83 IF X'=""
SET ^ACRDOC("DD",$EXTRACT(X,1,30),DA)=""
+84 SET X=$PIECE(DIKZ("TO"),U,19)
+85 IF X'=""
IF $EXTRACT(X)'="Y"
SET $PIECE(^ACRDOC(+$GET(DA),"TO"),U,25)=""
+86 SET X=$PIECE(DIKZ("TO"),U,18)
+87 IF X'=""
Begin DoDot:1
+88 NEW DIK,DIV,DIU,DIN
+89 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
SET X=$PIECE(Y(1),U,12)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,130150,1,1,1.4)
End DoDot:1
+90 SET DIKZ("TO")=$GET(^ACRDOC(DA,"TO"))
+91 SET X=$PIECE(DIKZ("TO"),U,16)
+92 IF X'=""
Begin DoDot:1
+93 NEW DIK,DIV,DIU,DIN
+94 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
SET X=$PIECE(Y(1),U,17)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,130151,1,1,1.1)
XECUTE ^DD(9002196,130151,1,1,1.4)
End DoDot:1
+95 SET X=$PIECE(DIKZ("TO"),U,16)
+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(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,130151,1,2,1.4)
End DoDot:1
+99 SET DIKZ("TOAU")=$GET(^ACRDOC(DA,"TOAU"))
+100 SET X=$PIECE(DIKZ("TOAU"),U,2)
+101 IF X'=""
Begin DoDot:1
+102 NEW DIK,DIV,DIU,DIN
+103 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,130154,1,1,1.4)
End DoDot:1
+104 SET X=$PIECE(DIKZ("TOAU"),U,2)
+105 IF X'=""
Begin DoDot:1
+106 NEW DIK,DIV,DIU,DIN
+107 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(9002196,130154,1,2,1.4)
End DoDot:1
+108 SET X=$PIECE(DIKZ("TOAU"),U,2)
+109 IF X'=""
Begin DoDot:1
+110 NEW DIK,DIV,DIU,DIN
+111 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,130154,1,3,1.1)
XECUTE ^DD(9002196,130154,1,3,1.4)
End DoDot:1
+112 SET DIKZ("TO")=$GET(^ACRDOC(DA,"TO"))
+113 SET X=$PIECE(DIKZ("TO"),U,22)
+114 IF X'=""
Begin DoDot:1
+115 NEW DIK,DIV,DIU,DIN
+116 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET X=Y(0)
SET X=X
SET X=X=0
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(9002196,130157,1,1,1.4)
End DoDot:1
+117 SET DIKZ(13)=$GET(^ACRDOC(DA,13))
+118 SET X=$PIECE(DIKZ(13),U,2)
+119 IF X'=""
Begin DoDot:1
+120 NEW DIK,DIV,DIU,DIN
+121 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
SET X=$PIECE(Y(1),U,26)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,130172,1,1,1.1)
XECUTE ^DD(9002196,130172,1,1,1.4)
End DoDot:1
+122 SET DIKZ("TOAU")=$GET(^ACRDOC(DA,"TOAU"))
+123 SET X=$PIECE(DIKZ("TOAU"),U,8)
+124 IF X'=""
Begin DoDot:1
+125 NEW DIK,DIV,DIU,DIN
+126 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
SET X=$PIECE(Y(1),U,26)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,130177,1,1,1.1)
XECUTE ^DD(9002196,130177,1,1,1.4)
End DoDot:1
+127 SET DIKZ("TOAU")=$GET(^ACRDOC(DA,"TOAU"))
+128 SET X=$PIECE(DIKZ("TOAU"),U,9)
+129 IF X'=""
SET ^ACRDOC("Q",$EXTRACT(X,1,30),DA)=""
+130 SET DIKZ("TRNG")=$GET(^ACRDOC(DA,"TRNG"))
+131 SET X=$PIECE(DIKZ("TRNG"),U,2)
+132 IF X'=""
SET ^ACRDOC("F",$EXTRACT(X,1,30),DA)=""
+133 SET X=$PIECE(DIKZ("TRNG"),U,2)
+134 IF X'=""
XECUTE ^DD(9002196,148030,1,2,1)
+135 SET X=$PIECE(DIKZ("TRNG"),U,2)
+136 IF X'=""
Begin DoDot:1
+137 NEW DIK,DIV,DIU,DIN
+138 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,148030,1,3,1.1)
XECUTE ^DD(9002196,148030,1,3,1.4)
End DoDot:1
+139 SET DIKZ("TRNG")=$GET(^ACRDOC(DA,"TRNG"))
+140 SET X=$PIECE(DIKZ("TRNG"),U,3)
+141 IF X'=""
SET ^ACRDOC("M",$EXTRACT(X,1,30),DA)=""
+142 SET X=$PIECE(DIKZ("TRNG"),U,4)
+143 IF X'=""
Begin DoDot:1
+144 NEW DIK,DIV,DIU,DIN
+145 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002196,148050,1,1,89.2)
SET X=$PIECE(Y(101),U,1)
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002196,148050,1,1,1.4)
End DoDot:1
+146 SET DIKZ("TRNG3")=$GET(^ACRDOC(DA,"TRNG3"))
+147 SET X=$PIECE(DIKZ("TRNG3"),U,1)
END GOTO ^ACRCD16
