ACRCR1 ; COMPILED XREF FOR FILE #9002189 ; 09/30/09
;
S DIKZK=2
S DIKZ(0)=$G(^ACROBL(DA,0))
S X=$P(DIKZ(0),U,2)
I X'="" K ^ACROBL("C",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,3)
I X'="" K ^ACROBL("D",$E(X,1,30),DA)
S X=$P(DIKZ(0),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(^ACROBL(D0,0)):^(0),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y X ^DD(9002189,.03,1,3,2.1) X ^DD(9002189,.03,1,3,2.4)
S X=$P(DIKZ(0),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002189,.03,1,4,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y X ^DD(9002189,.03,1,4,2.1) X ^DD(9002189,.03,1,4,2.4)
S X=$P(DIKZ(0),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(^ACROBL(D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y X ^DD(9002189,.03,1,5,2.1) X ^DD(9002189,.03,1,5,2.4)
S DIKZ(0)=$G(^ACROBL(DA,0))
S X=$P(DIKZ(0),U,4)
I X'="" K ^ACROBL("CAN",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,7)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002189,.07,1,1,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y X ^DD(9002189,.07,1,1,2.1) X ^DD(9002189,.07,1,1,2.4)
S X=$P(DIKZ(0),U,7)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002189,.07,1,2,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y X ^DD(9002189,.07,1,2,2.1) X ^DD(9002189,.07,1,2,2.4)
S DIKZ(0)=$G(^ACROBL(DA,0))
S X=$P(DIKZ(0),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002189,.09,1,1,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y X ^DD(9002189,.09,1,1,2.1) X ^DD(9002189,.09,1,1,2.4)
S X=$P(DIKZ(0),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002189,.09,1,2,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y X ^DD(9002189,.09,1,2,2.1) X ^DD(9002189,.09,1,2,2.4)
S DIKZ(0)=$G(^ACROBL(DA,0))
S X=$P(DIKZ(0),U,12)
I X'="" K ^ACROBL("LOT",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,13)
I X'="" K ^ACROBL("PROP",$E(X,1,30),DA)
S DIKZ("DT")=$G(^ACROBL(DA,"DT"))
S X=$P(DIKZ("DT"),U,1)
I X'="" K ^ACROBL("DOC",$E(X,1,30),DA)
S X=$P(DIKZ("DT"),U,3)
I X'="" K ^ACROBL("OC",$E(X,1,30),DA)
S DIKZ("VND")=$G(^ACROBL(DA,"VND"))
S X=$P(DIKZ("VND"),U,1)
I X'="" K ^ACROBL("VND",$E(X,1,30),DA)
S DIKZ("APV")=$G(^ACROBL(DA,"APV"))
S X=$P(DIKZ("APV"),U,1)
I X'="" K ^ACRDOC("RL",+$G(^ACRDOC(DA,"POST")),DA)
S DIKZ("CONV")=$G(^ACROBL(DA,"CONV"))
S X=$P(DIKZ("CONV"),U,1)
I X'="" I $D(^ACROBL(DA,"CONV")),$P(^("CONV"),U)["Y" K ^ACROBL("ACONV",$P(^ACROBL(DA,0),U,3),$P(^("CONV"),U),DA)
S X=$P(DIKZ("APV"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACROBL(D0,"APV")):^("APV"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002189,907,1,1,2.1) X ^DD(9002189,907,1,1,2.4)
S X=$P(DIKZ("APV"),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACROBL(D0,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(9002189,907,1,2,2.1) X ^DD(9002189,907,1,2,2.4)
S DIKZ("APV")=$G(^ACROBL(DA,"APV"))
S X=$P(DIKZ("APV"),U,6)
I X'="" K ^ACRDOC("RL",+$G(^ACRDOC(DA,"POST")),DA)
S X=$P(DIKZ("APV"),U,7)
I X'="" K ^ACROBL("TV",$E(X,1,30),DA)
S X=$P(DIKZ("APV"),U,8)
I X'="" I X]"",$P($G(^ACRDOC(DA,0)),U,8),+$G(^("REQ")) S ^ACRDOC("PO",+$P(^(0),U,8),"A",DA)=""
S X=$P(DIKZ("APV"),U,8)
I X'="" I X]"",+$G(^ACRDOC(DA,"PA")) S ^ACRDOC("P",+^("PA"),"A",DA)=""
END G ^ACRCR2
ACRCR1 ; COMPILED XREF FOR FILE #9002189 ; 09/30/09
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,2)
+5 IF X'=""
KILL ^ACROBL("C",$EXTRACT(X,1,30),DA)
+6 SET X=$PIECE(DIKZ(0),U,3)
+7 IF X'=""
KILL ^ACROBL("D",$EXTRACT(X,1,30),DA)
+8 SET X=$PIECE(DIKZ(0),U,3)
+9 IF X'=""
Begin DoDot:1
+10 NEW DIK,DIV,DIU,DIN
+11 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACROBL(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,12)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.03,1,3,2.1)
XECUTE ^DD(9002189,.03,1,3,2.4)
End DoDot:1
+12 SET X=$PIECE(DIKZ(0),U,3)
+13 IF X'=""
Begin DoDot:1
+14 NEW DIK,DIV,DIU,DIN
+15 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002189,.03,1,4,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.03,1,4,2.1)
XECUTE ^DD(9002189,.03,1,4,2.4)
End DoDot:1
+16 SET X=$PIECE(DIKZ(0),U,3)
+17 IF X'=""
Begin DoDot:1
+18 NEW DIK,DIV,DIU,DIN
+19 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACROBL(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.03,1,5,2.1)
XECUTE ^DD(9002189,.03,1,5,2.4)
End DoDot:1
+20 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+21 SET X=$PIECE(DIKZ(0),U,4)
+22 IF X'=""
KILL ^ACROBL("CAN",$EXTRACT(X,1,30),DA)
+23 SET X=$PIECE(DIKZ(0),U,7)
+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(9002189,.07,1,1,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.07,1,1,2.1)
XECUTE ^DD(9002189,.07,1,1,2.4)
End DoDot:1
+27 SET X=$PIECE(DIKZ(0),U,7)
+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(9002189,.07,1,2,89.2)
SET X=$PIECE(Y(101),U,3)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.07,1,2,2.1)
XECUTE ^DD(9002189,.07,1,2,2.4)
End DoDot:1
+31 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+32 SET X=$PIECE(DIKZ(0),U,9)
+33 IF X'=""
Begin DoDot:1
+34 NEW DIK,DIV,DIU,DIN
+35 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002189,.09,1,1,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.09,1,1,2.1)
XECUTE ^DD(9002189,.09,1,1,2.4)
End DoDot:1
+36 SET X=$PIECE(DIKZ(0),U,9)
+37 IF X'=""
Begin DoDot:1
+38 NEW DIK,DIV,DIU,DIN
+39 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002189,.09,1,2,89.2)
SET X=$PIECE(Y(101),U,3)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.09,1,2,2.1)
XECUTE ^DD(9002189,.09,1,2,2.4)
End DoDot:1
+40 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+41 SET X=$PIECE(DIKZ(0),U,12)
+42 IF X'=""
KILL ^ACROBL("LOT",$EXTRACT(X,1,30),DA)
+43 SET X=$PIECE(DIKZ(0),U,13)
+44 IF X'=""
KILL ^ACROBL("PROP",$EXTRACT(X,1,30),DA)
+45 SET DIKZ("DT")=$GET(^ACROBL(DA,"DT"))
+46 SET X=$PIECE(DIKZ("DT"),U,1)
+47 IF X'=""
KILL ^ACROBL("DOC",$EXTRACT(X,1,30),DA)
+48 SET X=$PIECE(DIKZ("DT"),U,3)
+49 IF X'=""
KILL ^ACROBL("OC",$EXTRACT(X,1,30),DA)
+50 SET DIKZ("VND")=$GET(^ACROBL(DA,"VND"))
+51 SET X=$PIECE(DIKZ("VND"),U,1)
+52 IF X'=""
KILL ^ACROBL("VND",$EXTRACT(X,1,30),DA)
+53 SET DIKZ("APV")=$GET(^ACROBL(DA,"APV"))
+54 SET X=$PIECE(DIKZ("APV"),U,1)
+55 IF X'=""
KILL ^ACRDOC("RL",+$GET(^ACRDOC(DA,"POST")),DA)
+56 SET DIKZ("CONV")=$GET(^ACROBL(DA,"CONV"))
+57 SET X=$PIECE(DIKZ("CONV"),U,1)
+58 IF X'=""
IF $DATA(^ACROBL(DA,"CONV"))
IF $PIECE(^("CONV"),U)["Y"
KILL ^ACROBL("ACONV",$PIECE(^ACROBL(DA,0),U,3),$PIECE(^("CONV"),U),DA)
+59 SET X=$PIECE(DIKZ("APV"),U,4)
+60 IF X'=""
Begin DoDot:1
+61 NEW DIK,DIV,DIU,DIN
+62 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACROBL(D0,"APV")):^("APV"),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002189,907,1,1,2.1)
XECUTE ^DD(9002189,907,1,1,2.4)
End DoDot:1
+63 SET X=$PIECE(DIKZ("APV"),U,4)
+64 IF X'=""
Begin DoDot:1
+65 NEW DIK,DIV,DIU,DIN
+66 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACROBL(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002189,907,1,2,2.1)
XECUTE ^DD(9002189,907,1,2,2.4)
End DoDot:1
+67 SET DIKZ("APV")=$GET(^ACROBL(DA,"APV"))
+68 SET X=$PIECE(DIKZ("APV"),U,6)
+69 IF X'=""
KILL ^ACRDOC("RL",+$GET(^ACRDOC(DA,"POST")),DA)
+70 SET X=$PIECE(DIKZ("APV"),U,7)
+71 IF X'=""
KILL ^ACROBL("TV",$EXTRACT(X,1,30),DA)
+72 SET X=$PIECE(DIKZ("APV"),U,8)
+73 IF X'=""
IF X]""
IF $PIECE($GET(^ACRDOC(DA,0)),U,8)
IF +$GET(^("REQ"))
SET ^ACRDOC("PO",+$PIECE(^(0),U,8),"A",DA)=""
+74 SET X=$PIECE(DIKZ("APV"),U,8)
+75 IF X'=""
IF X]""
IF +$GET(^ACRDOC(DA,"PA"))
SET ^ACRDOC("P",+^("PA"),"A",DA)=""
END GOTO ^ACRCR2
