ACRCR3 ; COMPILED XREF FOR FILE #9002189 ; 09/30/09
;
S DIKZK=1
S DIKZ(0)=$G(^ACROBL(DA,0))
S X=$P(DIKZ(0),U,2)
I X'="" S ^ACROBL("C",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,3)
I X'="" S ^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,2),X=X S DIU=X K Y X ^DD(9002189,.03,1,2,1.1) X ^DD(9002189,.03,1,2,1.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,12),X=X S DIU=X K Y X ^DD(9002189,.03,1,3,1.1) X ^DD(9002189,.03,1,3,1.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,1.1) X ^DD(9002189,.03,1,4,1.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,1.1) X ^DD(9002189,.03,1,5,1.4)
S DIKZ(0)=$G(^ACROBL(DA,0))
S X=$P(DIKZ(0),U,4)
I X'="" S ^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,1.1) X ^DD(9002189,.07,1,1,1.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,1.1) X ^DD(9002189,.07,1,2,1.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,1.1) X ^DD(9002189,.09,1,1,1.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,1.1) X ^DD(9002189,.09,1,2,1.4)
S DIKZ(0)=$G(^ACROBL(DA,0))
S X=$P(DIKZ(0),U,12)
I X'="" S ^ACROBL("LOT",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,13)
I X'="" S ^ACROBL("PROP",$E(X,1,30),DA)=""
S DIKZ("DT")=$G(^ACROBL(DA,"DT"))
S X=$P(DIKZ("DT"),U,1)
I X'="" S ^ACROBL("DOC",$E(X,1,30),DA)=""
S X=$P(DIKZ("DT"),U,3)
I X'="" S ^ACROBL("OC",$E(X,1,30),DA)=""
S DIKZ("VND")=$G(^ACROBL(DA,"VND"))
S X=$P(DIKZ("VND"),U,1)
I X'="" S ^ACROBL("VND",$E(X,1,30),DA)=""
S DIKZ("APV")=$G(^ACROBL(DA,"APV"))
S X=$P(DIKZ("APV"),U,1)
I X'="" I X="A",$P($G(^ACROBL(DA,"APV")),U,6)'=1,+$G(^ACRDOC(DA,"POST")) S ^ACRDOC("RL",+$G(^("POST")),DA)=""
S X=$P(DIKZ("APV"),U,3)
I X'="" ;I $D(ACRFINSS),$P(^ACROBL(DA,"APV"),U,3)="Y" D TSK^ACRPRINT
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" S ^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 S X=DIV S X=DIV,X=X X ^DD(9002189,907,1,1,1.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,1.1) X ^DD(9002189,907,1,2,1.4)
S DIKZ("APV")=$G(^ACROBL(DA,"APV"))
S X=$P(DIKZ("APV"),U,6)
I X'="" I X'=1,$E($G(^ACROBL(DA,"APV")))="A",+$G(^ACRDOC(DA,"POST")) S ^ACRDOC("RL",+^("POST"),DA)=""
S X=$P(DIKZ("APV"),U,7)
I X'="" S ^ACROBL("TV",$E(X,1,30),DA)=""
S X=$P(DIKZ("APV"),U,8)
I X'="" K:X]"" ^ACRDOC("PO",+$P($G(^ACRDOC(DA,0)),U,8),"A",DA)
S X=$P(DIKZ("APV"),U,8)
I X'="" K:X]"" ^ACRDOC("PA",+$G(^ACRDOC(DA,"PA")),"A",DA)
END G ^ACRCR4
ACRCR3 ; COMPILED XREF FOR FILE #9002189 ; 09/30/09
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,2)
+5 IF X'=""
SET ^ACROBL("C",$EXTRACT(X,1,30),DA)=""
+6 SET X=$PIECE(DIKZ(0),U,3)
+7 IF X'=""
SET ^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,2)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002189,.03,1,2,1.1)
XECUTE ^DD(9002189,.03,1,2,1.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
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,1.1)
XECUTE ^DD(9002189,.03,1,3,1.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
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,1.1)
XECUTE ^DD(9002189,.03,1,4,1.4)
End DoDot:1
+20 SET X=$PIECE(DIKZ(0),U,3)
+21 IF X'=""
Begin DoDot:1
+22 NEW DIK,DIV,DIU,DIN
+23 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,1.1)
XECUTE ^DD(9002189,.03,1,5,1.4)
End DoDot:1
+24 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+25 SET X=$PIECE(DIKZ(0),U,4)
+26 IF X'=""
SET ^ACROBL("CAN",$EXTRACT(X,1,30),DA)=""
+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,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,1.1)
XECUTE ^DD(9002189,.07,1,1,1.4)
End DoDot:1
+31 SET X=$PIECE(DIKZ(0),U,7)
+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(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,1.1)
XECUTE ^DD(9002189,.07,1,2,1.4)
End DoDot:1
+35 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+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,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,1.1)
XECUTE ^DD(9002189,.09,1,1,1.4)
End DoDot:1
+40 SET X=$PIECE(DIKZ(0),U,9)
+41 IF X'=""
Begin DoDot:1
+42 NEW DIK,DIV,DIU,DIN
+43 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,1.1)
XECUTE ^DD(9002189,.09,1,2,1.4)
End DoDot:1
+44 SET DIKZ(0)=$GET(^ACROBL(DA,0))
+45 SET X=$PIECE(DIKZ(0),U,12)
+46 IF X'=""
SET ^ACROBL("LOT",$EXTRACT(X,1,30),DA)=""
+47 SET X=$PIECE(DIKZ(0),U,13)
+48 IF X'=""
SET ^ACROBL("PROP",$EXTRACT(X,1,30),DA)=""
+49 SET DIKZ("DT")=$GET(^ACROBL(DA,"DT"))
+50 SET X=$PIECE(DIKZ("DT"),U,1)
+51 IF X'=""
SET ^ACROBL("DOC",$EXTRACT(X,1,30),DA)=""
+52 SET X=$PIECE(DIKZ("DT"),U,3)
+53 IF X'=""
SET ^ACROBL("OC",$EXTRACT(X,1,30),DA)=""
+54 SET DIKZ("VND")=$GET(^ACROBL(DA,"VND"))
+55 SET X=$PIECE(DIKZ("VND"),U,1)
+56 IF X'=""
SET ^ACROBL("VND",$EXTRACT(X,1,30),DA)=""
+57 SET DIKZ("APV")=$GET(^ACROBL(DA,"APV"))
+58 SET X=$PIECE(DIKZ("APV"),U,1)
+59 IF X'=""
IF X="A"
IF $PIECE($GET(^ACROBL(DA,"APV")),U,6)'=1
IF +$GET(^ACRDOC(DA,"POST"))
SET ^ACRDOC("RL",+$GET(^("POST")),DA)=""
+60 SET X=$PIECE(DIKZ("APV"),U,3)
+61 ;I $D(ACRFINSS),$P(^ACROBL(DA,"APV"),U,3)="Y" D TSK^ACRPRINT
IF X'=""
+62 SET DIKZ("CONV")=$GET(^ACROBL(DA,"CONV"))
+63 SET X=$PIECE(DIKZ("CONV"),U,1)
+64 IF X'=""
IF $DATA(^ACROBL(DA,"CONV"))
IF $PIECE(^("CONV"),U)["Y"
SET ^ACROBL("ACONV",$PIECE(^ACROBL(DA,0),U,3),$PIECE(^("CONV"),U),DA)=""
+65 SET X=$PIECE(DIKZ("APV"),U,4)
+66 IF X'=""
Begin DoDot:1
+67 NEW DIK,DIV,DIU,DIN
+68 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
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002189,907,1,1,1.4)
End DoDot:1
+69 SET X=$PIECE(DIKZ("APV"),U,4)
+70 IF X'=""
Begin DoDot:1
+71 NEW DIK,DIV,DIU,DIN
+72 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,1.1)
XECUTE ^DD(9002189,907,1,2,1.4)
End DoDot:1
+73 SET DIKZ("APV")=$GET(^ACROBL(DA,"APV"))
+74 SET X=$PIECE(DIKZ("APV"),U,6)
+75 IF X'=""
IF X'=1
IF $EXTRACT($GET(^ACROBL(DA,"APV")))="A"
IF +$GET(^ACRDOC(DA,"POST"))
SET ^ACRDOC("RL",+^("POST"),DA)=""
+76 SET X=$PIECE(DIKZ("APV"),U,7)
+77 IF X'=""
SET ^ACROBL("TV",$EXTRACT(X,1,30),DA)=""
+78 SET X=$PIECE(DIKZ("APV"),U,8)
+79 IF X'=""
IF X]""
KILL ^ACRDOC("PO",+$PIECE($GET(^ACRDOC(DA,0)),U,8),"A",DA)
+80 SET X=$PIECE(DIKZ("APV"),U,8)
+81 IF X'=""
IF X]""
KILL ^ACRDOC("PA",+$GET(^ACRDOC(DA,"PA")),"A",DA)
END GOTO ^ACRCR4
