IBXX10 ; COMPILED XREF FOR FILE #399 ; 02/13/06
;
S DIKZK=1
S DIKZ(0)=$G(^DGCR(399,DA,0))
S X=$P(DIKZ(0),U,1)
I X'="" S ^DGCR(399,"B",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,1)
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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,1)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,.01,1,3,1.4)
S X=$P(DIKZ(0),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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=$S(($D(DUZ)#2):DUZ,1:"") X ^DD(399,.01,1,4,1.4)
S X=$P(DIKZ(0),U,1)
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(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,14)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y X ^DD(399,.01,1,5,1.1) X ^DD(399,.01,1,5,1.4)
S X=$P(DIKZ(0),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(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=1 X ^DD(399,.01,1,6,1.4)
S X=$P(DIKZ(0),U,1)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,.01,1,7,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,19),X=X S DIU=X K Y S X=DIV S X=$P($G(^IBE(350.9,1,1)),U,26) X ^DD(399,.01,1,7,1.4)
S DIKZ(0)=$G(^DGCR(399,DA,0))
S X=$P(DIKZ(0),U,2)
I X'="" S ^DGCR(399,"C",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,3)
I X'="" S ^DGCR(399,"D",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,3)
I X'="" S IBN=$P(^DGCR(399,DA,0),"^",2) S:$D(IBN) ^DGCR(399,"APDT",IBN,DA,9999999-X)="" K IBN
S X=$P(DIKZ(0),U,3)
I X'="" S ^DGCR(399,"ABNDT",DA,9999999-X)=""
S X=$P(DIKZ(0),U,5)
I X'="" S ^DGCR(399,"ABT",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,7)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,.07,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X="Y" X ^DD(399,.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 S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y X ^DD(399,.07,1,2,1.1) X ^DD(399,.07,1,2,1.4)
S X=$P(DIKZ(0),U,7)
I X'="" S ^DGCR(399,"AD",$E(X,1,30),DA)=""
S DIKZ(0)=$G(^DGCR(399,DA,0))
S X=$P(DIKZ(0),U,8)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,.08,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=2 X ^DD(399,.08,1,1,1.4)
S X=$P(DIKZ(0),U,8)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,.08,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X=DIV S X=2 X ^DD(399,.08,1,2,1.4)
S X=$P(DIKZ(0),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(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=99 X ^DD(399,.08,1,3,1.4)
S X=$P(DIKZ(0),U,8)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,.08,1,4,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV D DIS^IBCU S X=X X ^DD(399,.08,1,4,1.4)
S X=$P(DIKZ(0),U,8)
I X'="" S ^DGCR(399,"APTF",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,8)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $P(^DGCR(399,DA,0),U,5)<3 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=+$$LOS1^IBCU64(DA) X ^DD(399,.08,1,6,1.4)
S DIKZ(0)=$G(^DGCR(399,DA,0))
S X=$P(DIKZ(0),U,11)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,.11,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV D EN1^IBCU5 X ^DD(399,.11,1,1,1.4)
S X=$P(DIKZ(0),U,11)
I X'="" D EN^IBCU5
S X=$P(DIKZ(0),U,11)
I X'="" S DGRVRCAL=1
S DIKZ(0)=$G(^DGCR(399,DA,0))
S X=$P(DIKZ(0),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,.13,1,1,1.4)
S X=$P(DIKZ(0),U,13)
I X'="" I X>0,X<3,$P(^DGCR(399,DA,0),U,2) S ^DGCR(399,"AOP",$P(^(0),U,2),DA)=""
S X=$P(DIKZ(0),U,13)
I X'="" I +X=3 S ^DGCR(399,"AST",+X,DA)=""
S DIKZ(0)=$G(^DGCR(399,DA,0))
S X=$P(DIKZ(0),U,17)
I X'="" S ^DGCR(399,"AC",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,19)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,.19,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=4 X ^DD(399,.19,1,1,1.4)
S X=$P(DIKZ(0),U,19)
I X'="" S DGRVRCAL=1
S DIKZ("S")=$G(^DGCR(399,DA,"S"))
S X=$P(DIKZ("S"),U,1)
I X'="" S ^DGCR(399,"APD",$E(X,1,30),DA)=""
S X=$P(DIKZ("S"),U,3)
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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,4)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,3,1,1,1.4)
S X=$P(DIKZ("S"),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,3,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,3,1,2,1.4)
S X=$P(DIKZ("S"),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,3,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X=+X X ^DD(399,3,1,3,1.4)
S DIKZ("S")=$G(^DGCR(399,DA,"S"))
S X=$P(DIKZ("S"),U,6)
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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,7)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,6,1,1,1.4)
S X=$P(DIKZ("S"),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,6,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,6,1,2,1.4)
S X=$P(DIKZ("S"),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y=Y(0) X:$D(^DD(399,6,2)) ^(2) S X=Y="YES" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=2 X ^DD(399,6,1,3,1.4)
S DIKZ("S")=$G(^DGCR(399,DA,"S"))
S X=$P(DIKZ("S"),U,9)
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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,10)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,9,1,1,1.4)
S X=$P(DIKZ("S"),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,9,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,9,1,2,1.4)
S X=$P(DIKZ("S"),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y=Y(0) X:$D(^DD(399,9,2)) ^(2) S X=Y="YES" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=3 X ^DD(399,9,1,3,1.4)
S DIKZ("S")=$G(^DGCR(399,DA,"S"))
S X=$P(DIKZ("S"),U,12)
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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,14)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,12,1,1,1.4)
S X=$P(DIKZ("S"),U,12)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,12,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,12,1,2,1.4)
S X=$P(DIKZ("S"),U,12)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,12,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,12,1,3,1.4)
S X=$P(DIKZ("S"),U,12)
I X'="" S ^DGCR(399,"AP",$E(X,1,30),DA)=""
S DIKZ("S")=$G(^DGCR(399,DA,"S"))
S X=$P(DIKZ("S"),U,14)
END G ^IBXX11
IBXX10 ; COMPILED XREF FOR FILE #399 ; 02/13/06
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^DGCR(399,DA,0))
+4 SET X=$PIECE(DIKZ(0),U,1)
+5 IF X'=""
SET ^DGCR(399,"B",$EXTRACT(X,1,30),DA)=""
+6 SET X=$PIECE(DIKZ(0),U,1)
+7 IF X'=""
Begin DoDot:1
+8 NEW DIK,DIV,DIU,DIN
+9 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,1)=""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(399,.01,1,3,1.4)
End DoDot:1
+10 SET X=$PIECE(DIKZ(0),U,1)
+11 IF X'=""
Begin DoDot:1
+12 NEW DIK,DIV,DIU,DIN
+13 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=$SELECT(($DATA(DUZ)#2):DUZ,1:"")
XECUTE ^DD(399,.01,1,4,1.4)
End DoDot:1
+14 SET X=$PIECE(DIKZ(0),U,1)
+15 IF X'=""
Begin DoDot:1
+16 NEW DIK,DIV,DIU,DIN
+17 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,14)=""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,.01,1,5,1.1)
XECUTE ^DD(399,.01,1,5,1.4)
End DoDot:1
+18 SET X=$PIECE(DIKZ(0),U,1)
+19 IF X'=""
Begin DoDot:1
+20 NEW DIK,DIV,DIU,DIN
+21 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=1
XECUTE ^DD(399,.01,1,6,1.4)
End DoDot:1
+22 SET X=$PIECE(DIKZ(0),U,1)
+23 IF X'=""
Begin DoDot:1
+24 NEW DIK,DIV,DIU,DIN
+25 XECUTE ^DD(399,.01,1,7,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,19)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=$PIECE($GET(^IBE(350.9,1,1)),U,26)
XECUTE ^DD(399,.01,1,7,1.4)
End DoDot:1
+26 SET DIKZ(0)=$GET(^DGCR(399,DA,0))
+27 SET X=$PIECE(DIKZ(0),U,2)
+28 IF X'=""
SET ^DGCR(399,"C",$EXTRACT(X,1,30),DA)=""
+29 SET X=$PIECE(DIKZ(0),U,3)
+30 IF X'=""
SET ^DGCR(399,"D",$EXTRACT(X,1,30),DA)=""
+31 SET X=$PIECE(DIKZ(0),U,3)
+32 IF X'=""
SET IBN=$PIECE(^DGCR(399,DA,0),"^",2)
IF $DATA(IBN)
SET ^DGCR(399,"APDT",IBN,DA,9999999-X)=""
KILL IBN
+33 SET X=$PIECE(DIKZ(0),U,3)
+34 IF X'=""
SET ^DGCR(399,"ABNDT",DA,9999999-X)=""
+35 SET X=$PIECE(DIKZ(0),U,5)
+36 IF X'=""
SET ^DGCR(399,"ABT",$EXTRACT(X,1,30),DA)=""
+37 SET X=$PIECE(DIKZ(0),U,7)
+38 IF X'=""
Begin DoDot:1
+39 NEW DIK,DIV,DIU,DIN
+40 XECUTE ^DD(399,.07,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,6)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X="Y"
XECUTE ^DD(399,.07,1,1,1.4)
End DoDot:1
+41 SET X=$PIECE(DIKZ(0),U,7)
+42 IF X'=""
Begin DoDot:1
+43 NEW DIK,DIV,DIU,DIN
+44 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,.07,1,2,1.1)
XECUTE ^DD(399,.07,1,2,1.4)
End DoDot:1
+45 SET X=$PIECE(DIKZ(0),U,7)
+46 IF X'=""
SET ^DGCR(399,"AD",$EXTRACT(X,1,30),DA)=""
+47 SET DIKZ(0)=$GET(^DGCR(399,DA,0))
+48 SET X=$PIECE(DIKZ(0),U,8)
+49 IF X'=""
Begin DoDot:1
+50 NEW DIK,DIV,DIU,DIN
+51 XECUTE ^DD(399,.08,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=2
XECUTE ^DD(399,.08,1,1,1.4)
End DoDot:1
+52 SET X=$PIECE(DIKZ(0),U,8)
+53 IF X'=""
Begin DoDot:1
+54 NEW DIK,DIV,DIU,DIN
+55 XECUTE ^DD(399,.08,1,2,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=2
XECUTE ^DD(399,.08,1,2,1.4)
End DoDot:1
+56 SET X=$PIECE(DIKZ(0),U,8)
+57 IF X'=""
Begin DoDot:1
+58 NEW DIK,DIV,DIU,DIN
+59 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=99
XECUTE ^DD(399,.08,1,3,1.4)
End DoDot:1
+60 SET X=$PIECE(DIKZ(0),U,8)
+61 IF X'=""
Begin DoDot:1
+62 NEW DIK,DIV,DIU,DIN
+63 XECUTE ^DD(399,.08,1,4,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,12)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
DO DIS^IBCU
SET X=X
XECUTE ^DD(399,.08,1,4,1.4)
End DoDot:1
+64 SET X=$PIECE(DIKZ(0),U,8)
+65 IF X'=""
SET ^DGCR(399,"APTF",$EXTRACT(X,1,30),DA)=""
+66 SET X=$PIECE(DIKZ(0),U,8)
+67 IF X'=""
Begin DoDot:1
+68 NEW DIK,DIV,DIU,DIN
+69 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
IF $PIECE(^DGCR(399,DA,0),U,5)<3
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U")):^("U"),1:"")
SET X=$PIECE(Y(1),U,15)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=+$$LOS1^IBCU64(DA)
XECUTE ^DD(399,.08,1,6,1.4)
End DoDot:1
+70 SET DIKZ(0)=$GET(^DGCR(399,DA,0))
+71 SET X=$PIECE(DIKZ(0),U,11)
+72 IF X'=""
Begin DoDot:1
+73 NEW DIK,DIV,DIU,DIN
+74 XECUTE ^DD(399,.11,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M")):^("M"),1:"")
SET X=$PIECE(Y(1),U,12)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
DO EN1^IBCU5
XECUTE ^DD(399,.11,1,1,1.4)
End DoDot:1
+75 SET X=$PIECE(DIKZ(0),U,11)
+76 IF X'=""
DO EN^IBCU5
+77 SET X=$PIECE(DIKZ(0),U,11)
+78 IF X'=""
SET DGRVRCAL=1
+79 SET DIKZ(0)=$GET(^DGCR(399,DA,0))
+80 SET X=$PIECE(DIKZ(0),U,13)
+81 IF X'=""
Begin DoDot:1
+82 NEW DIK,DIV,DIU,DIN
+83 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(399,.13,1,1,1.4)
End DoDot:1
+84 SET X=$PIECE(DIKZ(0),U,13)
+85 IF X'=""
IF X>0
IF X<3
IF $PIECE(^DGCR(399,DA,0),U,2)
SET ^DGCR(399,"AOP",$PIECE(^(0),U,2),DA)=""
+86 SET X=$PIECE(DIKZ(0),U,13)
+87 IF X'=""
IF +X=3
SET ^DGCR(399,"AST",+X,DA)=""
+88 SET DIKZ(0)=$GET(^DGCR(399,DA,0))
+89 SET X=$PIECE(DIKZ(0),U,17)
+90 IF X'=""
SET ^DGCR(399,"AC",$EXTRACT(X,1,30),DA)=""
+91 SET X=$PIECE(DIKZ(0),U,19)
+92 IF X'=""
Begin DoDot:1
+93 NEW DIK,DIV,DIU,DIN
+94 XECUTE ^DD(399,.19,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=4
XECUTE ^DD(399,.19,1,1,1.4)
End DoDot:1
+95 SET X=$PIECE(DIKZ(0),U,19)
+96 IF X'=""
SET DGRVRCAL=1
+97 SET DIKZ("S")=$GET(^DGCR(399,DA,"S"))
+98 SET X=$PIECE(DIKZ("S"),U,1)
+99 IF X'=""
SET ^DGCR(399,"APD",$EXTRACT(X,1,30),DA)=""
+100 SET X=$PIECE(DIKZ("S"),U,3)
+101 IF X'=""
Begin DoDot:1
+102 NEW DIK,DIV,DIU,DIN
+103 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,4)=""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(399,3,1,1,1.4)
End DoDot:1
+104 SET X=$PIECE(DIKZ("S"),U,3)
+105 IF X'=""
Begin DoDot:1
+106 NEW DIK,DIV,DIU,DIN
+107 XECUTE ^DD(399,3,1,2,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DUZ
XECUTE ^DD(399,3,1,2,1.4)
End DoDot:1
+108 SET X=$PIECE(DIKZ("S"),U,3)
+109 IF X'=""
Begin DoDot:1
+110 NEW DIK,DIV,DIU,DIN
+111 XECUTE ^DD(399,3,1,3,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,6)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=+X
XECUTE ^DD(399,3,1,3,1.4)
End DoDot:1
+112 SET DIKZ("S")=$GET(^DGCR(399,DA,"S"))
+113 SET X=$PIECE(DIKZ("S"),U,6)
+114 IF X'=""
Begin DoDot:1
+115 NEW DIK,DIV,DIU,DIN
+116 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,7)=""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(399,6,1,1,1.4)
End DoDot:1
+117 SET X=$PIECE(DIKZ("S"),U,6)
+118 IF X'=""
Begin DoDot:1
+119 NEW DIK,DIV,DIU,DIN
+120 XECUTE ^DD(399,6,1,2,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DUZ
XECUTE ^DD(399,6,1,2,1.4)
End DoDot:1
+121 SET X=$PIECE(DIKZ("S"),U,6)
+122 IF X'=""
Begin DoDot:1
+123 NEW DIK,DIV,DIU,DIN
+124 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y=Y(0)
IF $DATA(^DD(399,6,2))
XECUTE ^(2)
SET X=Y="YES"
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=2
XECUTE ^DD(399,6,1,3,1.4)
End DoDot:1
+125 SET DIKZ("S")=$GET(^DGCR(399,DA,"S"))
+126 SET X=$PIECE(DIKZ("S"),U,9)
+127 IF X'=""
Begin DoDot:1
+128 NEW DIK,DIV,DIU,DIN
+129 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,10)=""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(399,9,1,1,1.4)
End DoDot:1
+130 SET X=$PIECE(DIKZ("S"),U,9)
+131 IF X'=""
Begin DoDot:1
+132 NEW DIK,DIV,DIU,DIN
+133 XECUTE ^DD(399,9,1,2,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DUZ
XECUTE ^DD(399,9,1,2,1.4)
End DoDot:1
+134 SET X=$PIECE(DIKZ("S"),U,9)
+135 IF X'=""
Begin DoDot:1
+136 NEW DIK,DIV,DIU,DIN
+137 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y=Y(0)
IF $DATA(^DD(399,9,2))
XECUTE ^(2)
SET X=Y="YES"
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=3
XECUTE ^DD(399,9,1,3,1.4)
End DoDot:1
+138 SET DIKZ("S")=$GET(^DGCR(399,DA,"S"))
+139 SET X=$PIECE(DIKZ("S"),U,12)
+140 IF X'=""
Begin DoDot:1
+141 NEW DIK,DIV,DIU,DIN
+142 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,14)=""
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(399,12,1,1,1.4)
End DoDot:1
+143 SET X=$PIECE(DIKZ("S"),U,12)
+144 IF X'=""
Begin DoDot:1
+145 NEW DIK,DIV,DIU,DIN
+146 XECUTE ^DD(399,12,1,2,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,15)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DUZ
XECUTE ^DD(399,12,1,2,1.4)
End DoDot:1
+147 SET X=$PIECE(DIKZ("S"),U,12)
+148 IF X'=""
Begin DoDot:1
+149 NEW DIK,DIV,DIU,DIN
+150 XECUTE ^DD(399,12,1,3,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DUZ
XECUTE ^DD(399,12,1,3,1.4)
End DoDot:1
+151 SET X=$PIECE(DIKZ("S"),U,12)
+152 IF X'=""
SET ^DGCR(399,"AP",$EXTRACT(X,1,30),DA)=""
+153 SET DIKZ("S")=$GET(^DGCR(399,DA,"S"))
+154 SET X=$PIECE(DIKZ("S"),U,14)
END GOTO ^IBXX11
