IBXA1 ; COMPILED XREF FOR FILE #350 ; 02/13/06
;
S DIKZK=2
S DIKZ(0)=$G(^IB(DA,0))
S X=$P(DIKZ(0),U,2)
I X'="" K ^IB("C",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,2)
I X'="" I $D(^IB(DA,0)),$P(^(0),"^",17) K ^IB("AFDT",X,-$P(^(0),"^",17),DA)
S X=$P(DIKZ(0),U,2)
I X'="" I $D(^IB(DA,1)),$P(^(1),"^",2) K ^IB("APTDT",X,$P(^(1),"^",2),DA)
S X=$P(DIKZ(0),U,2)
I X'="" I $D(^IB(DA,0)),$P(^(0),U,5)=8 K ^IB("AH",X,DA)
S X=$P(DIKZ(0),U,2)
I X'="" I $D(^IB(DA,0)),$P(^(0),U,5)=99 K ^IB("AI",X,DA)
S X=$P(DIKZ(0),U,2)
I X'="" I X,$D(^IB(DA,1)),$P(^(1),"^",5) K ^IB("ACVA",X,$P(^(1),"^",5),DA)
S X=$P(DIKZ(0),U,3)
I X'="" K ^IB("AE",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,5)
I X'="" K ^IB("AC",$E(X,1,30),DA)
S X=$P(DIKZ(0),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(^IB(D0,1)):^(1),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X=$S($D(IBDUZ):IBDUZ,$D(DUZ):DUZ,1:.5) X ^DD(350,.05,1,2,2.4)
S X=$P(DIKZ(0),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(^IB(D0,1)):^(1),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(350,.05,1,3,2.1) X ^DD(350,.05,1,3,2.4)
S X=$P(DIKZ(0),U,5)
I X'="" I $D(^IB(DA,0)),$P(^(0),"^",16) K ^IB("ACT",$P(^(0),"^",16),DA)
S X=$P(DIKZ(0),U,5)
I X'="" I $P(^IB(DA,0),U,2) K ^IB("AH",$P(^IB(DA,0),U,2),DA)
S X=$P(DIKZ(0),U,5)
I X'="" I $P(^IB(DA,0),U,2) K ^IB("AI",$P(^IB(DA,0),U,2),DA)
S DIKZ(0)=$G(^IB(DA,0))
S X=$P(DIKZ(0),U,9)
I X'="" K ^IB("AD",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,9)
I X'="" I $D(^IB(DA,1)),$P(^(1),"^",2) K ^IB("APDT",$E(X,1,30),-$P(^(1),"^",2),DA)
S X=$P(DIKZ(0),U,11)
I X'="" K ^IB("ABIL",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,12)
I X'="" K ^IB("AT",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,16)
I X'="" K ^IB("AF",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,16)
I X'="" K ^IB("ACT",X,DA)
S X=$P(DIKZ(0),U,17)
I X'="" I $D(^IB(DA,0)),$P(^(0),"^",2) K ^IB("AFDT",$P(^(0),"^",2),-X,DA)
S DIKZ(1)=$G(^IB(DA,1))
S X=$P(DIKZ(1),U,2)
I X'="" K ^IB("D",$E(X,1,30),DA)
S X=$P(DIKZ(1),U,2)
I X'="" I $P(^IB(DA,0),"^",9) K ^IB("APDT",$P(^(0),"^",9),-X,DA)
S X=$P(DIKZ(1),U,2)
I X'="" I $D(^IB(DA,0)),$P(^(0),"^",2) K ^IB("APTDT",$P(^(0),"^",2),X,DA)
S X=$P(DIKZ(1),U,5)
I X'="" I X,$D(^IB(DA,0)),$P(^(0),"^",2) K ^IB("ACVA",$P(^(0),"^",2),X,DA)
S X=$P(DIKZ(0),U,1)
I X'="" K ^IB("B",$E(X,1,30),DA)
END Q
IBXA1 ; COMPILED XREF FOR FILE #350 ; 02/13/06
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^IB(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,2)
+5 IF X'=""
KILL ^IB("C",$EXTRACT(X,1,30),DA)
+6 SET X=$PIECE(DIKZ(0),U,2)
+7 IF X'=""
IF $DATA(^IB(DA,0))
IF $PIECE(^(0),"^",17)
KILL ^IB("AFDT",X,-$PIECE(^(0),"^",17),DA)
+8 SET X=$PIECE(DIKZ(0),U,2)
+9 IF X'=""
IF $DATA(^IB(DA,1))
IF $PIECE(^(1),"^",2)
KILL ^IB("APTDT",X,$PIECE(^(1),"^",2),DA)
+10 SET X=$PIECE(DIKZ(0),U,2)
+11 IF X'=""
IF $DATA(^IB(DA,0))
IF $PIECE(^(0),U,5)=8
KILL ^IB("AH",X,DA)
+12 SET X=$PIECE(DIKZ(0),U,2)
+13 IF X'=""
IF $DATA(^IB(DA,0))
IF $PIECE(^(0),U,5)=99
KILL ^IB("AI",X,DA)
+14 SET X=$PIECE(DIKZ(0),U,2)
+15 IF X'=""
IF X
IF $DATA(^IB(DA,1))
IF $PIECE(^(1),"^",5)
KILL ^IB("ACVA",X,$PIECE(^(1),"^",5),DA)
+16 SET X=$PIECE(DIKZ(0),U,3)
+17 IF X'=""
KILL ^IB("AE",$EXTRACT(X,1,30),DA)
+18 SET X=$PIECE(DIKZ(0),U,5)
+19 IF X'=""
KILL ^IB("AC",$EXTRACT(X,1,30),DA)
+20 SET X=$PIECE(DIKZ(0),U,5)
+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(1)=$SELECT($DATA(^IB(D0,1)):^(1),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=$SELECT($DATA(IBDUZ):IBDUZ,$DATA(DUZ):DUZ,1:.5)
XECUTE ^DD(350,.05,1,2,2.4)
End DoDot:1
+24 SET X=$PIECE(DIKZ(0),U,5)
+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(1)=$SELECT($DATA(^IB(D0,1)):^(1),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(350,.05,1,3,2.1)
XECUTE ^DD(350,.05,1,3,2.4)
End DoDot:1
+28 SET X=$PIECE(DIKZ(0),U,5)
+29 IF X'=""
IF $DATA(^IB(DA,0))
IF $PIECE(^(0),"^",16)
KILL ^IB("ACT",$PIECE(^(0),"^",16),DA)
+30 SET X=$PIECE(DIKZ(0),U,5)
+31 IF X'=""
IF $PIECE(^IB(DA,0),U,2)
KILL ^IB("AH",$PIECE(^IB(DA,0),U,2),DA)
+32 SET X=$PIECE(DIKZ(0),U,5)
+33 IF X'=""
IF $PIECE(^IB(DA,0),U,2)
KILL ^IB("AI",$PIECE(^IB(DA,0),U,2),DA)
+34 SET DIKZ(0)=$GET(^IB(DA,0))
+35 SET X=$PIECE(DIKZ(0),U,9)
+36 IF X'=""
KILL ^IB("AD",$EXTRACT(X,1,30),DA)
+37 SET X=$PIECE(DIKZ(0),U,9)
+38 IF X'=""
IF $DATA(^IB(DA,1))
IF $PIECE(^(1),"^",2)
KILL ^IB("APDT",$EXTRACT(X,1,30),-$PIECE(^(1),"^",2),DA)
+39 SET X=$PIECE(DIKZ(0),U,11)
+40 IF X'=""
KILL ^IB("ABIL",$EXTRACT(X,1,30),DA)
+41 SET X=$PIECE(DIKZ(0),U,12)
+42 IF X'=""
KILL ^IB("AT",$EXTRACT(X,1,30),DA)
+43 SET X=$PIECE(DIKZ(0),U,16)
+44 IF X'=""
KILL ^IB("AF",$EXTRACT(X,1,30),DA)
+45 SET X=$PIECE(DIKZ(0),U,16)
+46 IF X'=""
KILL ^IB("ACT",X,DA)
+47 SET X=$PIECE(DIKZ(0),U,17)
+48 IF X'=""
IF $DATA(^IB(DA,0))
IF $PIECE(^(0),"^",2)
KILL ^IB("AFDT",$PIECE(^(0),"^",2),-X,DA)
+49 SET DIKZ(1)=$GET(^IB(DA,1))
+50 SET X=$PIECE(DIKZ(1),U,2)
+51 IF X'=""
KILL ^IB("D",$EXTRACT(X,1,30),DA)
+52 SET X=$PIECE(DIKZ(1),U,2)
+53 IF X'=""
IF $PIECE(^IB(DA,0),"^",9)
KILL ^IB("APDT",$PIECE(^(0),"^",9),-X,DA)
+54 SET X=$PIECE(DIKZ(1),U,2)
+55 IF X'=""
IF $DATA(^IB(DA,0))
IF $PIECE(^(0),"^",2)
KILL ^IB("APTDT",$PIECE(^(0),"^",2),X,DA)
+56 SET X=$PIECE(DIKZ(1),U,5)
+57 IF X'=""
IF X
IF $DATA(^IB(DA,0))
IF $PIECE(^(0),"^",2)
KILL ^IB("ACVA",$PIECE(^(0),"^",2),X,DA)
+58 SET X=$PIECE(DIKZ(0),U,1)
+59 IF X'=""
KILL ^IB("B",$EXTRACT(X,1,30),DA)
END QUIT
