ACRCD13.m

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