ACRCD15.m

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