IBXX11 ; COMPILED XREF FOR FILE #399 ; 02/13/06
;
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=4 X ^DD(399,14,1,1,1.4)
S X=$P(DIKZ("S"),U,14)
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,15),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,14,1,3,1.4)
S DIKZ("S")=$G(^DGCR(399,DA,"S"))
S X=$P(DIKZ("S"),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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,17),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,16,1,1,1.4)
S X=$P(DIKZ("S"),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(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,18),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,16,1,2,1.4)
S DIKZ("S")=$G(^DGCR(399,DA,"S"))
S X=$P(DIKZ("S"),U,17)
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,"S"),U,16)=1 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=7 X ^DD(399,17,1,1,1.4)
S DIKZ("C")=$G(^DGCR(399,DA,"C"))
S X=$P(DIKZ("C"),U,14)
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),"^",5)>2 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"C")):^("C"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=$P(^ICD9(+X,0),"^",3) X ^DD(399,64,1,1,1.4)
S DIKZ("M")=$G(^DGCR(399,DA,"M"))
S X=$P(DIKZ("M"),U,1)
I X'="" D MAILA^IBCU5
S X=$P(DIKZ("M"),U,1)
I X'="" S DGRVRCAL=1
S X=$P(DIKZ("M"),U,1)
I X'="" S:$P(^DGCR(399,DA,0),"^",2) ^DGCR(399,"AE",$P(^(0),U,2),X,DA)=""
S X=$P(DIKZ("M"),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,19),X=X S DIU=X K Y S X=DIV S X=$$FT^IBCU3(DA) X ^DD(399,101,1,4,1.4)
S X=$P(DIKZ("M"),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,"M1")):^("M1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(399,101,1,5,1.1) X ^DD(399,101,1,5,1.4)
S DIKZ("M")=$G(^DGCR(399,DA,"M"))
S X=$P(DIKZ("M"),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(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(399,102,1,2,1.1) X ^DD(399,102,1,2,1.4)
S DIKZ("M")=$G(^DGCR(399,DA,"M"))
S X=$P(DIKZ("M"),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(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(399,103,1,2,1.1) X ^DD(399,103,1,2,1.4)
S DIKZ("M")=$G(^DGCR(399,DA,"M"))
S X=$P(DIKZ("M"),U,11)
I X'="" D MAILIN^IBCU5
S X=$P(DIKZ("M"),U,11)
I X'="" S DGRVRCAL=1
S X=$P(DIKZ("M"),U,12)
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,"M")):^("M"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(399,112,1,1,1.1) X ^DD(399,112,1,1,1.4)
S X=$P(DIKZ("M"),U,12)
I X'="" D IX^IBCNS2(DA,"I1")
S DIKZ("M")=$G(^DGCR(399,DA,"M"))
S X=$P(DIKZ("M"),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,"M")):^("M"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(399,113,1,1,1.1) X ^DD(399,113,1,1,1.4)
S X=$P(DIKZ("M"),U,13)
I X'="" D IX^IBCNS2(DA,"I2")
S DIKZ("M")=$G(^DGCR(399,DA,"M"))
S X=$P(DIKZ("M"),U,14)
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,"M")):^("M"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(399,114,1,1,1.1) X ^DD(399,114,1,1,1.4)
S X=$P(DIKZ("M"),U,14)
I X'="" D IX^IBCNS2(DA,"I3")
S DIKZ("U")=$G(^DGCR(399,DA,"U"))
S X=$P(DIKZ("U"),U,1)
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,151,1,1,1.4)
S X=$P(DIKZ("U"),U,1)
I X'="" S DGRVRCAL=1
S X=$P(DIKZ("U"),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,"U1")):^("U1"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(399,151,1,3,1.1) X ^DD(399,151,1,3,1.4)
S DIKZ("U")=$G(^DGCR(399,DA,"U"))
S X=$P(DIKZ("U"),U,2)
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,152,1,1,1.4)
S X=$P(DIKZ("U"),U,2)
I X'="" S DGRVRCAL=1
S DIKZ("U")=$G(^DGCR(399,DA,"U"))
S X=$P(DIKZ("U"),U,11)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,161,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,12),X=X S DIU=X K Y S X=DIV D DIS^IBCU S X=X X ^DD(399,161,1,1,1.4)
S DIKZ("U1")=$G(^DGCR(399,DA,"U1"))
S X=$P(DIKZ("U1"),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,"U1")):^("U1"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(399,201,1,1,1.4)
S DIKZ("U1")=$G(^DGCR(399,DA,"U1"))
S X=$P(DIKZ("U1"),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.X ^DD(399,210,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y X ^DD(399,210,1,1,1.1) X ^DD(399,210,1,1,1.4)
END G ^IBXX12
IBXX11 ; COMPILED XREF FOR FILE #399 ; 02/13/06
+1 ;
+2 IF X'=""
Begin DoDot:1
+3 NEW DIK,DIV,DIU,DIN
+4 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=4
XECUTE ^DD(399,14,1,1,1.4)
End DoDot:1
+5 SET X=$PIECE(DIKZ("S"),U,14)
+6 IF X'=""
Begin DoDot:1
+7 NEW DIK,DIV,DIU,DIN
+8 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,15)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DUZ
XECUTE ^DD(399,14,1,3,1.4)
End DoDot:1
+9 SET DIKZ("S")=$GET(^DGCR(399,DA,"S"))
+10 SET X=$PIECE(DIKZ("S"),U,16)
+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,17)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DT
XECUTE ^DD(399,16,1,1,1.4)
End DoDot:1
+14 SET X=$PIECE(DIKZ("S"),U,16)
+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(1)=$SELECT($DATA(^DGCR(399,D0,"S")):^("S"),1:"")
SET X=$PIECE(Y(1),U,18)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DUZ
XECUTE ^DD(399,16,1,2,1.4)
End DoDot:1
+18 SET DIKZ("S")=$GET(^DGCR(399,DA,"S"))
+19 SET X=$PIECE(DIKZ("S"),U,17)
+20 IF X'=""
Begin DoDot:1
+21 NEW DIK,DIV,DIU,DIN
+22 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
IF $PIECE(^DGCR(399,DA,"S"),U,16)=1
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=7
XECUTE ^DD(399,17,1,1,1.4)
End DoDot:1
+23 SET DIKZ("C")=$GET(^DGCR(399,DA,"C"))
+24 SET X=$PIECE(DIKZ("C"),U,14)
+25 IF X'=""
Begin DoDot:1
+26 NEW DIK,DIV,DIU,DIN
+27 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(0)=X
IF $PIECE(^DGCR(399,DA,0),"^",5)>2
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"C")):^("C"),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=$PIECE(^ICD9(+X,0),"^",3)
XECUTE ^DD(399,64,1,1,1.4)
End DoDot:1
+28 SET DIKZ("M")=$GET(^DGCR(399,DA,"M"))
+29 SET X=$PIECE(DIKZ("M"),U,1)
+30 IF X'=""
DO MAILA^IBCU5
+31 SET X=$PIECE(DIKZ("M"),U,1)
+32 IF X'=""
SET DGRVRCAL=1
+33 SET X=$PIECE(DIKZ("M"),U,1)
+34 IF X'=""
IF $PIECE(^DGCR(399,DA,0),"^",2)
SET ^DGCR(399,"AE",$PIECE(^(0),U,2),X,DA)=""
+35 SET X=$PIECE(DIKZ("M"),U,1)
+36 IF X'=""
Begin DoDot:1
+37 NEW DIK,DIV,DIU,DIN
+38 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,19)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=$$FT^IBCU3(DA)
XECUTE ^DD(399,101,1,4,1.4)
End DoDot:1
+39 SET X=$PIECE(DIKZ("M"),U,1)
+40 IF X'=""
Begin DoDot:1
+41 NEW DIK,DIV,DIU,DIN
+42 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M1")):^("M1"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,101,1,5,1.1)
XECUTE ^DD(399,101,1,5,1.4)
End DoDot:1
+43 SET DIKZ("M")=$GET(^DGCR(399,DA,"M"))
+44 SET X=$PIECE(DIKZ("M"),U,2)
+45 IF X'=""
Begin DoDot:1
+46 NEW DIK,DIV,DIU,DIN
+47 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M1")):^("M1"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,102,1,2,1.1)
XECUTE ^DD(399,102,1,2,1.4)
End DoDot:1
+48 SET DIKZ("M")=$GET(^DGCR(399,DA,"M"))
+49 SET X=$PIECE(DIKZ("M"),U,3)
+50 IF X'=""
Begin DoDot:1
+51 NEW DIK,DIV,DIU,DIN
+52 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M1")):^("M1"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,103,1,2,1.1)
XECUTE ^DD(399,103,1,2,1.4)
End DoDot:1
+53 SET DIKZ("M")=$GET(^DGCR(399,DA,"M"))
+54 SET X=$PIECE(DIKZ("M"),U,11)
+55 IF X'=""
DO MAILIN^IBCU5
+56 SET X=$PIECE(DIKZ("M"),U,11)
+57 IF X'=""
SET DGRVRCAL=1
+58 SET X=$PIECE(DIKZ("M"),U,12)
+59 IF X'=""
Begin DoDot:1
+60 NEW DIK,DIV,DIU,DIN
+61 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M")):^("M"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,112,1,1,1.1)
XECUTE ^DD(399,112,1,1,1.4)
End DoDot:1
+62 SET X=$PIECE(DIKZ("M"),U,12)
+63 IF X'=""
DO IX^IBCNS2(DA,"I1")
+64 SET DIKZ("M")=$GET(^DGCR(399,DA,"M"))
+65 SET X=$PIECE(DIKZ("M"),U,13)
+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(^DGCR(399,D0,"M")):^("M"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,113,1,1,1.1)
XECUTE ^DD(399,113,1,1,1.4)
End DoDot:1
+69 SET X=$PIECE(DIKZ("M"),U,13)
+70 IF X'=""
DO IX^IBCNS2(DA,"I2")
+71 SET DIKZ("M")=$GET(^DGCR(399,DA,"M"))
+72 SET X=$PIECE(DIKZ("M"),U,14)
+73 IF X'=""
Begin DoDot:1
+74 NEW DIK,DIV,DIU,DIN
+75 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M")):^("M"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,114,1,1,1.1)
XECUTE ^DD(399,114,1,1,1.4)
End DoDot:1
+76 SET X=$PIECE(DIKZ("M"),U,14)
+77 IF X'=""
DO IX^IBCNS2(DA,"I3")
+78 SET DIKZ("U")=$GET(^DGCR(399,DA,"U"))
+79 SET X=$PIECE(DIKZ("U"),U,1)
+80 IF X'=""
Begin DoDot:1
+81 NEW DIK,DIV,DIU,DIN
+82 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,151,1,1,1.4)
End DoDot:1
+83 SET X=$PIECE(DIKZ("U"),U,1)
+84 IF X'=""
SET DGRVRCAL=1
+85 SET X=$PIECE(DIKZ("U"),U,1)
+86 IF X'=""
Begin DoDot:1
+87 NEW DIK,DIV,DIU,DIN
+88 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U1")):^("U1"),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,151,1,3,1.1)
XECUTE ^DD(399,151,1,3,1.4)
End DoDot:1
+89 SET DIKZ("U")=$GET(^DGCR(399,DA,"U"))
+90 SET X=$PIECE(DIKZ("U"),U,2)
+91 IF X'=""
Begin DoDot:1
+92 NEW DIK,DIV,DIU,DIN
+93 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,152,1,1,1.4)
End DoDot:1
+94 SET X=$PIECE(DIKZ("U"),U,2)
+95 IF X'=""
SET DGRVRCAL=1
+96 SET DIKZ("U")=$GET(^DGCR(399,DA,"U"))
+97 SET X=$PIECE(DIKZ("U"),U,11)
+98 IF X'=""
Begin DoDot:1
+99 NEW DIK,DIV,DIU,DIN
+100 XECUTE ^DD(399,161,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,12)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
DO DIS^IBCU
SET X=X
XECUTE ^DD(399,161,1,1,1.4)
End DoDot:1
+101 SET DIKZ("U1")=$GET(^DGCR(399,DA,"U1"))
+102 SET X=$PIECE(DIKZ("U1"),U,1)
+103 IF X'=""
Begin DoDot:1
+104 NEW DIK,DIV,DIU,DIN
+105 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U1")):^("U1"),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
XECUTE ^DD(399,201,1,1,1.4)
End DoDot:1
+106 SET DIKZ("U1")=$GET(^DGCR(399,DA,"U1"))
+107 SET X=$PIECE(DIKZ("U1"),U,10)
+108 IF X'=""
Begin DoDot:1
+109 NEW DIK,DIV,DIU,DIN
+110 XECUTE ^DD(399,210,1,1,1.3)
IF X
SET X=DIV
SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U1")):^("U1"),1:"")
SET X=$PIECE(Y(1),U,12)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(399,210,1,1,1.1)
XECUTE ^DD(399,210,1,1,1.4)
End DoDot:1
END GOTO ^IBXX12
