ACRCD13 ; COMPILED XREF FOR FILE #9002196 ; 09/30/09
;
S DIKZK=1
S DIKZ(0)=$G(^ACRDOC(DA,0))
S X=$P(DIKZ(0),U,1)
I X'="" S ^ACRDOC("B",$E(X,1,30),DA)=""
S DIKZ("X")=$G(^ACRDOC(DA,"X"))
S X=$P(DIKZ("X"),U,1)
I X'="" S:'$D(^ACRDOC("B",$E(X,1,30),DA)) ^(DA)=1
S X=$P(DIKZ(0),U,2)
I X'="" S ^ACRDOC("C",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),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,"X")):^("X"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=$$EXPDN^ACRFUTL(D0) S DIH=$G(^ACRDOC(DIV(0),"X")),DIV=X S $P(^("X"),U,1)=DIV,DIH=9002196,DIG=.011 D ^DICR
S DIKZ(0)=$G(^ACRDOC(DA,0))
S X=$P(DIKZ(0),U,3)
I X'="" S ^ACRDOC("DT",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,4)
I X'="" S ^ACRDOC("D",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X X ^DD(9002196,.04,1,2,69.2) S X=X=116 S D0=I(0,0) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"PO")):^("PO"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002196,.04,1,2,1.1) X ^DD(9002196,.04,1,2,1.4)
S X=$P(DIKZ(0),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,.04,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y X ^DD(9002196,.04,1,3,1.1) X ^DD(9002196,.04,1,3,1.4)
S X=$P(DIKZ(0),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,.04,1,4,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,0)):^(0),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(9002196,.04,1,4,1.4)
S DIKZ(0)=$G(^ACRDOC(DA,0))
S X=$P(DIKZ(0),U,5)
I X'="" S ^ACRDOC("E",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,8)
I X'="" S ^ACRDOC("PO",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,8)
I X'="" I X,+$G(^ACRDOC(DA,"REQ")) S ^ACRDOC("PO",X,"A",DA)=""
S X=$P(DIKZ(0),U,13)
I X'="" S ^ACRDOC("REF",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,14)
I X'="" S ^ACRDOC("G",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,15)
I X'="" S ^ACRDOC("MOD",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,17)
I X'="" S ^ACRDOC("O",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,17)
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,"X")):^("X"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=$$ORN17^ACRFTRIG(D0) S DIH=$G(^ACRDOC(DIV(0),"X")),DIV=X S $P(^("X"),U,1)=DIV,DIH=9002196,DIG=.011 D ^DICR
S DIKZ(0)=$G(^ACRDOC(DA,0))
S X=$P(DIKZ(0),U,18)
I X'="" S:X>0 ^ACRDOC("T",DA,DA)=""
S X=$P(DIKZ(0),U,19)
I X'="" S ^ACRDOC("BPA",$E(X,1,30),DA)=""
S DIKZ("PA")=$G(^ACRDOC(DA,"PA"))
S X=$P(DIKZ("PA"),U,1)
I X'="" S ^ACRDOC("PA",$E(X,1,30),DA)=""
S X=$P(DIKZ("PA"),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,"PA")):^("PA"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(9002196,.2,1,2,1.1) X ^DD(9002196,.2,1,2,1.4)
S X=$P(DIKZ("PA"),U,1)
I X'="" S:X ^ACRDOC("PA",X,"A",DA)=""
S DIKZ(0)=$G(^ACRDOC(DA,0))
S X=$P(DIKZ(0),U,26)
I X'="" S ^ACRDOC("FS","FS"_$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,27)
I X'="" S ^ACRDOC("FS",$E(X,1,30),DA)=""
S DIKZ("PA")=$G(^ACRDOC(DA,"PA"))
S X=$P(DIKZ("PA"),U,3)
I X'="" S ^ACRDOC("PS",$E(X,1,30),DA)=""
S DIKZ("FA")=$G(^ACRDOC(DA,"FA"))
S X=$P(DIKZ("FA"),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,11,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,11,1,1,1.4)
S DIKZ("FA")=$G(^ACRDOC(DA,"FA"))
S X=$P(DIKZ("FA"),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,12,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,12,1,1,1.4)
S DIKZ("AU")=$G(^ACRDOC(DA,"AU"))
S X=$P(DIKZ("AU"),U,1)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X X ^DD(9002196,20,1,1,69.2) S X=X=103,Y=X,X=Y(2),X=X!Y I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"PO")):^("PO"),1:"") S X=$P(Y(1),U,17),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002196,20,1,1,1.4)
S DIKZ(18)=$G(^ACRDOC(DA,18))
S X=$P(DIKZ(18),U,1)
I X'="" S ^ACRDOC("P","SC"_$E(X,1,30),DA)=""
S DIKZ("PO")=$G(^ACRDOC(DA,"PO"))
S X=$P(DIKZ("PO"),U,1)
I X'="" S ^ACRDOC("S",$E(X,1,30),DA)=""
S X=$P(DIKZ("PO"),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^ACRDOC(D0,0)):^(0),1:"") S X=$P(Y(1),U,24),X=X S X=X>0 I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002196,103020,1,1,1.4)
S DIKZ("POST")=$G(^ACRDOC(DA,"POST"))
S X=$P(DIKZ("POST"),U,1)
I X'="" I $D(DA),DA,$D(^ACRDOC(DA,"PO")),$P(^("PO"),U,12) S ^ACRDOC("DI",$E(X,1,30),$P(^("PO"),U,12),DA)=""
S X=$P(DIKZ("POST"),U,1)
I X'="" I $E($G(^ACROBL(+$G(DA),"APV")))="A",$P($G(^("APV")),U,6)'=1 S ^ACRDOC("RL",$E(X,1,30),DA)=""
S DIKZ("PO")=$G(^ACRDOC(DA,"PO"))
S X=$P(DIKZ("PO"),U,5)
I X'="" S ^ACRDOC("I",$E(X,1,30),DA)=""
S X=$P(DIKZ("PO"),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,5)):^(5),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(9002196,103070,1,2,1.1) X ^DD(9002196,103070,1,2,1.4)
S X=$P(DIKZ("PO"),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,5)):^(5),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,103070,1,3,1.4)
S X=$P(DIKZ("PO"),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,5)):^(5),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002196,103070,1,4,1.1) X ^DD(9002196,103070,1,4,1.4)
S DIKZ("PO")=$G(^ACRDOC(DA,"PO"))
S X=$P(DIKZ("PO"),U,12)
I X'="" I $D(DA),DA,$D(^ACRDOC(DA,"POST")),+^("POST") S ^ACRDOC("DI",+^("POST"),$E(X,1,30),DA)=""
S X=$P(DIKZ("PO"),U,16)
I X'="" S ^ACRDOC("L",$E(X,1,30),DA)=""
S X=$P(DIKZ("PO"),U,16)
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)]"" I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"POST")):^("POST"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002196,103200,1,2,1.4)
S DIKZ(5)=$G(^ACRDOC(DA,5))
S X=$P(DIKZ(5),U,5)
I X'="" S ^ACRDOC("I",$E(X,1,30),DA)=""
S X=$P(DIKZ(5),U,3)
I X'="" S ^ACRDOC("J",$E(X,1,30),DA)=""
S DIKZ("REQ")=$G(^ACRDOC(DA,"REQ"))
S X=$P(DIKZ("REQ"),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,"PO")):^("PO"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002196,113030,1,1,1.4)
S DIKZ("REQ")=$G(^ACRDOC(DA,"REQ"))
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,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,1,1.1) X ^DD(9002196,113100,1,1,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,"AU")):^("AU"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,2,1.1) X ^DD(9002196,113100,1,2,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"POIO")):^("POIO"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,3,1.1) X ^DD(9002196,113100,1,3,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,4,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"POST")):^("POST"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,4,1.1) X ^DD(9002196,113100,1,4,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,5,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(9002196,113100,1,5,1.1) X ^DD(9002196,113100,1,5,1.4)
S X=$P(DIKZ("REQ"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(9002196,113100,1,6,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"PO")):^("PO"),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y X ^DD(9002196,113100,1,6,1.1) X ^DD(9002196,113100,1,6,1.4)
S X=$P(DIKZ("REQ"),U,10)
END G ^ACRCD14
ACRCD13 ; COMPILED XREF FOR FILE #9002196 ; 09/30/09
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^ACRDOC(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,1)
+5 IF X'=""
SET ^ACRDOC("B",$EXTRACT(X,1,30),DA)=""
+6 SET DIKZ("X")=$GET(^ACRDOC(DA,"X"))
+7 SET X=$PIECE(DIKZ("X"),U,1)
+8 IF X'=""
IF '$DATA(^ACRDOC("B",$EXTRACT(X,1,30),DA))
SET ^(DA)=1
+9 SET X=$PIECE(DIKZ(0),U,2)
+10 IF X'=""
SET ^ACRDOC("C",$EXTRACT(X,1,30),DA)=""
+11 SET X=$PIECE(DIKZ(0),U,2)
+12 IF X'=""
Begin DoDot:1
+13 NEW DIK,DIV,DIU,DIN
+14 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"X")):^("X"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=$$EXPDN^ACRFUTL(D0)
SET DIH=$GET(^ACRDOC(DIV(0),"X"))
SET DIV=X
SET $PIECE(^("X"),U,1)=DIV
SET DIH=9002196
SET DIG=.011
DO ^DICR
End DoDot:1
+15 SET DIKZ(0)=$GET(^ACRDOC(DA,0))
+16 SET X=$PIECE(DIKZ(0),U,3)
+17 IF X'=""
SET ^ACRDOC("DT",$EXTRACT(X,1,30),DA)=""
+18 SET X=$PIECE(DIKZ(0),U,4)
+19 IF X'=""
SET ^ACRDOC("D",$EXTRACT(X,1,30),DA)=""
+20 SET X=$PIECE(DIKZ(0),U,4)
+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(0)=X
XECUTE ^DD(9002196,.04,1,2,69.2)
SET X=X=116
SET D0=I(0,0)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"PO")):^("PO"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,.04,1,2,1.1)
XECUTE ^DD(9002196,.04,1,2,1.4)
End DoDot:1
+24 SET X=$PIECE(DIKZ(0),U,4)
+25 IF X'=""
Begin DoDot:1
+26 NEW DIK,DIV,DIU,DIN
+27 XECUTE ^DD(9002196,.04,1,3,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,.04,1,3,1.1)
XECUTE ^DD(9002196,.04,1,3,1.4)
End DoDot:1
+28 SET X=$PIECE(DIKZ(0),U,4)
+29 IF X'=""
Begin DoDot:1
+30 NEW DIK,DIV,DIU,DIN
+31 XECUTE ^DD(9002196,.04,1,4,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,0)):^(0),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(9002196,.04,1,4,1.4)
End DoDot:1
+32 SET DIKZ(0)=$GET(^ACRDOC(DA,0))
+33 SET X=$PIECE(DIKZ(0),U,5)
+34 IF X'=""
SET ^ACRDOC("E",$EXTRACT(X,1,30),DA)=""
+35 SET X=$PIECE(DIKZ(0),U,8)
+36 IF X'=""
SET ^ACRDOC("PO",$EXTRACT(X,1,30),DA)=""
+37 SET X=$PIECE(DIKZ(0),U,8)
+38 IF X'=""
IF X
IF +$GET(^ACRDOC(DA,"REQ"))
SET ^ACRDOC("PO",X,"A",DA)=""
+39 SET X=$PIECE(DIKZ(0),U,13)
+40 IF X'=""
SET ^ACRDOC("REF",$EXTRACT(X,1,30),DA)=""
+41 SET X=$PIECE(DIKZ(0),U,14)
+42 IF X'=""
SET ^ACRDOC("G",$EXTRACT(X,1,30),DA)=""
+43 SET X=$PIECE(DIKZ(0),U,15)
+44 IF X'=""
SET ^ACRDOC("MOD",$EXTRACT(X,1,30),DA)=""
+45 SET X=$PIECE(DIKZ(0),U,17)
+46 IF X'=""
SET ^ACRDOC("O",$EXTRACT(X,1,30),DA)=""
+47 SET X=$PIECE(DIKZ(0),U,17)
+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,"X")):^("X"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=$$ORN17^ACRFTRIG(D0)
SET DIH=$GET(^ACRDOC(DIV(0),"X"))
SET DIV=X
SET $PIECE(^("X"),U,1)=DIV
SET DIH=9002196
SET DIG=.011
DO ^DICR
End DoDot:1
+51 SET DIKZ(0)=$GET(^ACRDOC(DA,0))
+52 SET X=$PIECE(DIKZ(0),U,18)
+53 IF X'=""
IF X>0
SET ^ACRDOC("T",DA,DA)=""
+54 SET X=$PIECE(DIKZ(0),U,19)
+55 IF X'=""
SET ^ACRDOC("BPA",$EXTRACT(X,1,30),DA)=""
+56 SET DIKZ("PA")=$GET(^ACRDOC(DA,"PA"))
+57 SET X=$PIECE(DIKZ("PA"),U,1)
+58 IF X'=""
SET ^ACRDOC("PA",$EXTRACT(X,1,30),DA)=""
+59 SET X=$PIECE(DIKZ("PA"),U,1)
+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(^ACRDOC(D0,"PA")):^("PA"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,.2,1,2,1.1)
XECUTE ^DD(9002196,.2,1,2,1.4)
End DoDot:1
+63 SET X=$PIECE(DIKZ("PA"),U,1)
+64 IF X'=""
IF X
SET ^ACRDOC("PA",X,"A",DA)=""
+65 SET DIKZ(0)=$GET(^ACRDOC(DA,0))
+66 SET X=$PIECE(DIKZ(0),U,26)
+67 IF X'=""
SET ^ACRDOC("FS","FS"_$EXTRACT(X,1,30),DA)=""
+68 SET X=$PIECE(DIKZ(0),U,27)
+69 IF X'=""
SET ^ACRDOC("FS",$EXTRACT(X,1,30),DA)=""
+70 SET DIKZ("PA")=$GET(^ACRDOC(DA,"PA"))
+71 SET X=$PIECE(DIKZ("PA"),U,3)
+72 IF X'=""
SET ^ACRDOC("PS",$EXTRACT(X,1,30),DA)=""
+73 SET DIKZ("FA")=$GET(^ACRDOC(DA,"FA"))
+74 SET X=$PIECE(DIKZ("FA"),U,2)
+75 IF X'=""
Begin DoDot:1
+76 NEW DIK,DIV,DIU,DIN
+77 XECUTE ^DD(9002196,11,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,11,1,1,1.4)
End DoDot:1
+78 SET DIKZ("FA")=$GET(^ACRDOC(DA,"FA"))
+79 SET X=$PIECE(DIKZ("FA"),U,3)
+80 IF X'=""
Begin DoDot:1
+81 NEW DIK,DIV,DIU,DIN
+82 XECUTE ^DD(9002196,12,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,12,1,1,1.4)
End DoDot:1
+83 SET DIKZ("AU")=$GET(^ACRDOC(DA,"AU"))
+84 SET X=$PIECE(DIKZ("AU"),U,1)
+85 IF X'=""
Begin DoDot:1
+86 NEW DIK,DIV,DIU,DIN
+87 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
XECUTE ^DD(9002196,20,1,1,69.2)
SET X=X=103
SET Y=X
SET X=Y(2)
SET X=X!Y
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"PO")):^("PO"),1:"")
SET X=$PIECE(Y(1),U,17)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002196,20,1,1,1.4)
End DoDot:1
+88 SET DIKZ(18)=$GET(^ACRDOC(DA,18))
+89 SET X=$PIECE(DIKZ(18),U,1)
+90 IF X'=""
SET ^ACRDOC("P","SC"_$EXTRACT(X,1,30),DA)=""
+91 SET DIKZ("PO")=$GET(^ACRDOC(DA,"PO"))
+92 SET X=$PIECE(DIKZ("PO"),U,1)
+93 IF X'=""
SET ^ACRDOC("S",$EXTRACT(X,1,30),DA)=""
+94 SET X=$PIECE(DIKZ("PO"),U,2)
+95 IF X'=""
Begin DoDot:1
+96 NEW DIK,DIV,DIU,DIN
+97 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,24)
SET X=X
SET X=X>0
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,0)):^(0),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,103020,1,1,1.4)
End DoDot:1
+98 SET DIKZ("POST")=$GET(^ACRDOC(DA,"POST"))
+99 SET X=$PIECE(DIKZ("POST"),U,1)
+100 IF X'=""
IF $DATA(DA)
IF DA
IF $DATA(^ACRDOC(DA,"PO"))
IF $PIECE(^("PO"),U,12)
SET ^ACRDOC("DI",$EXTRACT(X,1,30),$PIECE(^("PO"),U,12),DA)=""
+101 SET X=$PIECE(DIKZ("POST"),U,1)
+102 IF X'=""
IF $EXTRACT($GET(^ACROBL(+$GET(DA),"APV")))="A"
IF $PIECE($GET(^("APV")),U,6)'=1
SET ^ACRDOC("RL",$EXTRACT(X,1,30),DA)=""
+103 SET DIKZ("PO")=$GET(^ACRDOC(DA,"PO"))
+104 SET X=$PIECE(DIKZ("PO"),U,5)
+105 IF X'=""
SET ^ACRDOC("I",$EXTRACT(X,1,30),DA)=""
+106 SET X=$PIECE(DIKZ("PO"),U,5)
+107 IF X'=""
Begin DoDot:1
+108 NEW DIK,DIV,DIU,DIN
+109 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,5)):^(5),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,103070,1,2,1.1)
XECUTE ^DD(9002196,103070,1,2,1.4)
End DoDot:1
+110 SET X=$PIECE(DIKZ("PO"),U,5)
+111 IF X'=""
Begin DoDot:1
+112 NEW DIK,DIV,DIU,DIN
+113 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,5)):^(5),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,103070,1,3,1.4)
End DoDot:1
+114 SET X=$PIECE(DIKZ("PO"),U,5)
+115 IF X'=""
Begin DoDot:1
+116 NEW DIK,DIV,DIU,DIN
+117 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,5)):^(5),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,103070,1,4,1.1)
XECUTE ^DD(9002196,103070,1,4,1.4)
End DoDot:1
+118 SET DIKZ("PO")=$GET(^ACRDOC(DA,"PO"))
+119 SET X=$PIECE(DIKZ("PO"),U,12)
+120 IF X'=""
IF $DATA(DA)
IF DA
IF $DATA(^ACRDOC(DA,"POST"))
IF +^("POST")
SET ^ACRDOC("DI",+^("POST"),$EXTRACT(X,1,30),DA)=""
+121 SET X=$PIECE(DIKZ("PO"),U,16)
+122 IF X'=""
SET ^ACRDOC("L",$EXTRACT(X,1,30),DA)=""
+123 SET X=$PIECE(DIKZ("PO"),U,16)
+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(0)=X
SET X=Y(0)]""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POST")):^("POST"),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002196,103200,1,2,1.4)
End DoDot:1
+127 SET DIKZ(5)=$GET(^ACRDOC(DA,5))
+128 SET X=$PIECE(DIKZ(5),U,5)
+129 IF X'=""
SET ^ACRDOC("I",$EXTRACT(X,1,30),DA)=""
+130 SET X=$PIECE(DIKZ(5),U,3)
+131 IF X'=""
SET ^ACRDOC("J",$EXTRACT(X,1,30),DA)=""
+132 SET DIKZ("REQ")=$GET(^ACRDOC(DA,"REQ"))
+133 SET X=$PIECE(DIKZ("REQ"),U,3)
+134 IF X'=""
Begin DoDot:1
+135 NEW DIK,DIV,DIU,DIN
+136 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"PO")):^("PO"),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(9002196,113030,1,1,1.4)
End DoDot:1
+137 SET DIKZ("REQ")=$GET(^ACRDOC(DA,"REQ"))
+138 SET X=$PIECE(DIKZ("REQ"),U,10)
+139 IF X'=""
Begin DoDot:1
+140 NEW DIK,DIV,DIU,DIN
+141 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,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,1,1.1)
XECUTE ^DD(9002196,113100,1,1,1.4)
End DoDot:1
+142 SET X=$PIECE(DIKZ("REQ"),U,10)
+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
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
XECUTE ^DD(9002196,113100,1,2,1.1)
XECUTE ^DD(9002196,113100,1,2,1.4)
End DoDot:1
+146 SET X=$PIECE(DIKZ("REQ"),U,10)
+147 IF X'=""
Begin DoDot:1
+148 NEW DIK,DIV,DIU,DIN
+149 XECUTE ^DD(9002196,113100,1,3,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POIO")):^("POIO"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,3,1.1)
XECUTE ^DD(9002196,113100,1,3,1.4)
End DoDot:1
+150 SET X=$PIECE(DIKZ("REQ"),U,10)
+151 IF X'=""
Begin DoDot:1
+152 NEW DIK,DIV,DIU,DIN
+153 XECUTE ^DD(9002196,113100,1,4,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POST")):^("POST"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,4,1.1)
XECUTE ^DD(9002196,113100,1,4,1.4)
End DoDot:1
+154 SET X=$PIECE(DIKZ("REQ"),U,10)
+155 IF X'=""
Begin DoDot:1
+156 NEW DIK,DIV,DIU,DIN
+157 XECUTE ^DD(9002196,113100,1,5,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,5,1.1)
XECUTE ^DD(9002196,113100,1,5,1.4)
End DoDot:1
+158 SET X=$PIECE(DIKZ("REQ"),U,10)
+159 IF X'=""
Begin DoDot:1
+160 NEW DIK,DIV,DIU,DIN
+161 XECUTE ^DD(9002196,113100,1,6,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"PO")):^("PO"),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002196,113100,1,6,1.1)
XECUTE ^DD(9002196,113100,1,6,1.4)
End DoDot:1
+162 SET X=$PIECE(DIKZ("REQ"),U,10)
END GOTO ^ACRCD14
