DGPTXX1 ; COMPILED XREF FOR FILE #45 ; 10/15/12
;
S DIKZK=2
S DIKZ(0)=$G(^DGPT(DA,0))
S X=$P($G(DIKZ(0)),U,2)
I X'="" S L=+^DGPT(DA,0) I L>0 K ^DGPT("AAD",L,X,DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" K ^DGPT("AF",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" K ^DGPT("AADA",X,DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" I $P(^DGPT(DA,0),U,4),$P(^(0),U) K ^DGPT("AFEE",$P(^DGPT(DA,0),U),$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,4)
I X'="" I $P(^DGPT(DA,0),U),$P(^(0),U,2) K ^DGPT("AFEE",$P(^DGPT(DA,0),U),$P(^DGPT(DA,0),U,2),DA)
S X=$P($G(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(^DGPT(D0,101)):^(101),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" S DIH=$S($D(^DGPT(DIV(0),101)):^(101),1:""),DIV=X S $P(^(101),U,1)=DIV,DIH=45,DIG=20 D ^DICR:$O(^DD(DIH,DIG,1,0))>0
S DIKZ(0)=$G(^DGPT(DA,0))
S X=$P($G(DIKZ(0)),U,6)
I X'="" K ^DGPT("AS",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,10)
I X'="" K ^DGPT("AMT",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,12)
I X'="" K ^DGPT("ACENSUS",$E(X,1,30),DA)
S X=$P($G(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(^DGPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X=DIV S X=1 S DIH=$S($D(^DGPT(DIV(0),0)):^(0),1:""),DIV=X S $P(^(0),U,11)=DIV,DIH=45,DIG=11 D ^DICR
S DIKZ(101)=$G(^DGPT(DA,101))
S X=$P($G(DIKZ(101)),U,4)
I X'="" S %=+^DGPT(DA,0) I $D(^DPT(%,.3)) S %C=$P(^(.3),U,10) I %C S ^(.3)=$P(^(.3),U,1,9)_U_U_$P(^(.3),U,11,99) K ^DPT("ACB",%C,%),%,%C
S DIKZ("401P")=$G(^DGPT(DA,"401P"))
S X=$P($G(DIKZ("401P")),U,1)
I X'="" K ^DGPT(DA,"AP",X)
S X=$P($G(DIKZ("401P")),U,2)
I X'="" K ^DGPT(DA,"AP",X)
S X=$P($G(DIKZ("401P")),U,3)
I X'="" K ^DGPT(DA,"AP",X)
S X=$P($G(DIKZ("401P")),U,4)
I X'="" K ^DGPT(DA,"AP",X)
S X=$P($G(DIKZ("401P")),U,5)
I X'="" K ^DGPT(DA,"AP",X)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,1)
I X'="" K ^DGPT("ADS",$E(X,1,30),DA)
S X=$P($G(DIKZ(70)),U,1)
I X'="" S %=$S($D(^DGPT(DA,"M",1,0)):^(0),1:""),%D=+$P(%,U,10),^(0)=$P(%_"^^^^^^^^^^",U,1,9)_U_X_U_$P(%,U,11,99) K ^DGPT(DA,"M","AM",%D,1),%,%D
S X=$P($G(DIKZ(70)),U,1)
I X'="" S L=$P(^DGPT(DA,0),"^",2) I L?7N.E,$G(DIK)'="^DGPT(" S ^DGPT("AADA",L,DA)=""
S X=$P($G(DIKZ(70)),U,2)
I X'="" I $D(^DGPT(DA,"M",1,0)) S $P(^(0),U,2)="",$P(^(0),U,16)=""
S X=$P($G(DIKZ(70)),U,10)
I X'="" X ^DD(45,79,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,16)
I X'="" X ^DD(45,79.16,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,17)
I X'="" X ^DD(45,79.17,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,18)
I X'="" X ^DD(45,79.18,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,19)
I X'="" X ^DD(45,79.19,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,20)
I X'="" X ^DD(45,79.201,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,21)
I X'="" X ^DD(45,79.21,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,22)
I X'="" X ^DD(45,79.22,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,23)
I X'="" X ^DD(45,79.23,1,992,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,24)
I X'="" X ^DD(45,79.24,1,992,2)
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,1)
I X'="" X ^DD(45,79.241,1,1,2)
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,2)
I X'="" X ^DD(45,79.242,1,1,2)
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,3)
I X'="" X ^DD(45,79.243,1,1,2)
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,4)
I X'="" X ^DD(45,79.244,1,1,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X=$P($G(DIKZ(70)),U,11)
I X'="" X ^DD(45,80,1,992,2)
S DIKZ(0)=$G(^DGPT(DA,0))
S X=$P($G(DIKZ(0)),U,1)
I X'="" K ^DGPT("B",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" X ^DD(45,.01,1,2,2)
CR1 S DIXR=366
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(4)=$P(DIKZ(70),U,16)
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD1")
CR2 S DIXR=367
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(4)=$P(DIKZ(71),U,1)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD10")
CR3 S DIXR=368
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(4)=$P(DIKZ(71),U,2)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD11")
CR4 S DIXR=369
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(4)=$P(DIKZ(71),U,3)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD12")
CR5 S DIXR=370
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(4)=$P(DIKZ(71),U,4)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD13")
CR6 S DIXR=371
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(4)=$P(DIKZ(70),U,17)
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD2")
CR7 S DIXR=372
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(4)=$P(DIKZ(70),U,18)
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD3")
CR8 S DIXR=373
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(4)=$P(DIKZ(70),U,19)
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD4")
CR9 S DIXR=374
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(4)=$P(DIKZ(70),U,20)
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD5")
CR10 S DIXR=375
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(4)=$P(DIKZ(70),U,21)
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
. D KDGPT9D^DGPTDDCR(.X,.DA,"D SD6")
CR11 S DIXR=376
K X
S DIKZ(0)=$G(^DGPT(DA,0))
END G ^DGPTXX2
DGPTXX1 ; COMPILED XREF FOR FILE #45 ; 10/15/12
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^DGPT(DA,0))
+4 SET X=$PIECE($GET(DIKZ(0)),U,2)
+5 IF X'=""
SET L=+^DGPT(DA,0)
IF L>0
KILL ^DGPT("AAD",L,X,DA)
+6 SET X=$PIECE($GET(DIKZ(0)),U,2)
+7 IF X'=""
KILL ^DGPT("AF",$EXTRACT(X,1,30),DA)
+8 SET X=$PIECE($GET(DIKZ(0)),U,2)
+9 IF X'=""
KILL ^DGPT("AADA",X,DA)
+10 SET X=$PIECE($GET(DIKZ(0)),U,2)
+11 IF X'=""
IF $PIECE(^DGPT(DA,0),U,4)
IF $PIECE(^(0),U)
KILL ^DGPT("AFEE",$PIECE(^DGPT(DA,0),U),$EXTRACT(X,1,30),DA)
+12 SET X=$PIECE($GET(DIKZ(0)),U,4)
+13 IF X'=""
IF $PIECE(^DGPT(DA,0),U)
IF $PIECE(^(0),U,2)
KILL ^DGPT("AFEE",$PIECE(^DGPT(DA,0),U),$PIECE(^DGPT(DA,0),U,2),DA)
+14 SET X=$PIECE($GET(DIKZ(0)),U,5)
+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(^DGPT(D0,101)):^(101),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$SELECT($DATA(^DGPT(DIV(0),101)):^(101),1:"")
SET DIV=X
SET $PIECE(^(101),U,1)=DIV
SET DIH=45
SET DIG=20
IF $ORDER(^DD(DIH,DIG,1,0))>0
DO ^DICR
End DoDot:1
+18 SET DIKZ(0)=$GET(^DGPT(DA,0))
+19 SET X=$PIECE($GET(DIKZ(0)),U,6)
+20 IF X'=""
KILL ^DGPT("AS",$EXTRACT(X,1,30),DA)
+21 SET X=$PIECE($GET(DIKZ(0)),U,10)
+22 IF X'=""
KILL ^DGPT("AMT",$EXTRACT(X,1,30),DA)
+23 SET X=$PIECE($GET(DIKZ(0)),U,12)
+24 IF X'=""
KILL ^DGPT("ACENSUS",$EXTRACT(X,1,30),DA)
+25 SET X=$PIECE($GET(DIKZ(0)),U,13)
+26 IF X'=""
Begin DoDot:1
+27 NEW DIK,DIV,DIU,DIN
+28 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=1
SET DIH=$SELECT($DATA(^DGPT(DIV(0),0)):^(0),1:"")
SET DIV=X
SET $PIECE(^(0),U,11)=DIV
SET DIH=45
SET DIG=11
DO ^DICR
End DoDot:1
+29 SET DIKZ(101)=$GET(^DGPT(DA,101))
+30 SET X=$PIECE($GET(DIKZ(101)),U,4)
+31 IF X'=""
SET %=+^DGPT(DA,0)
IF $DATA(^DPT(%,.3))
SET %C=$PIECE(^(.3),U,10)
IF %C
SET ^(.3)=$PIECE(^(.3),U,1,9)_U_U_$PIECE(^(.3),U,11,99)
KILL ^DPT("ACB",%C,%),%,%C
+32 SET DIKZ("401P")=$GET(^DGPT(DA,"401P"))
+33 SET X=$PIECE($GET(DIKZ("401P")),U,1)
+34 IF X'=""
KILL ^DGPT(DA,"AP",X)
+35 SET X=$PIECE($GET(DIKZ("401P")),U,2)
+36 IF X'=""
KILL ^DGPT(DA,"AP",X)
+37 SET X=$PIECE($GET(DIKZ("401P")),U,3)
+38 IF X'=""
KILL ^DGPT(DA,"AP",X)
+39 SET X=$PIECE($GET(DIKZ("401P")),U,4)
+40 IF X'=""
KILL ^DGPT(DA,"AP",X)
+41 SET X=$PIECE($GET(DIKZ("401P")),U,5)
+42 IF X'=""
KILL ^DGPT(DA,"AP",X)
+43 SET DIKZ(70)=$GET(^DGPT(DA,70))
+44 SET X=$PIECE($GET(DIKZ(70)),U,1)
+45 IF X'=""
KILL ^DGPT("ADS",$EXTRACT(X,1,30),DA)
+46 SET X=$PIECE($GET(DIKZ(70)),U,1)
+47 IF X'=""
SET %=$SELECT($DATA(^DGPT(DA,"M",1,0)):^(0),1:"")
SET %D=+$PIECE(%,U,10)
SET ^(0)=$PIECE(%_"^^^^^^^^^^",U,1,9)_U_X_U_$PIECE(%,U,11,99)
KILL ^DGPT(DA,"M","AM",%D,1),%,%D
+48 SET X=$PIECE($GET(DIKZ(70)),U,1)
+49 IF X'=""
SET L=$PIECE(^DGPT(DA,0),"^",2)
IF L?7N.E
IF $GET(DIK)'="^DGPT("
SET ^DGPT("AADA",L,DA)=""
+50 SET X=$PIECE($GET(DIKZ(70)),U,2)
+51 IF X'=""
IF $DATA(^DGPT(DA,"M",1,0))
SET $PIECE(^(0),U,2)=""
SET $PIECE(^(0),U,16)=""
+52 SET X=$PIECE($GET(DIKZ(70)),U,10)
+53 IF X'=""
XECUTE ^DD(45,79,1,992,2)
+54 SET DIKZ(70)=$GET(^DGPT(DA,70))
+55 SET X=$PIECE($GET(DIKZ(70)),U,16)
+56 IF X'=""
XECUTE ^DD(45,79.16,1,992,2)
+57 SET DIKZ(70)=$GET(^DGPT(DA,70))
+58 SET X=$PIECE($GET(DIKZ(70)),U,17)
+59 IF X'=""
XECUTE ^DD(45,79.17,1,992,2)
+60 SET DIKZ(70)=$GET(^DGPT(DA,70))
+61 SET X=$PIECE($GET(DIKZ(70)),U,18)
+62 IF X'=""
XECUTE ^DD(45,79.18,1,992,2)
+63 SET DIKZ(70)=$GET(^DGPT(DA,70))
+64 SET X=$PIECE($GET(DIKZ(70)),U,19)
+65 IF X'=""
XECUTE ^DD(45,79.19,1,992,2)
+66 SET DIKZ(70)=$GET(^DGPT(DA,70))
+67 SET X=$PIECE($GET(DIKZ(70)),U,20)
+68 IF X'=""
XECUTE ^DD(45,79.201,1,992,2)
+69 SET DIKZ(70)=$GET(^DGPT(DA,70))
+70 SET X=$PIECE($GET(DIKZ(70)),U,21)
+71 IF X'=""
XECUTE ^DD(45,79.21,1,992,2)
+72 SET DIKZ(70)=$GET(^DGPT(DA,70))
+73 SET X=$PIECE($GET(DIKZ(70)),U,22)
+74 IF X'=""
XECUTE ^DD(45,79.22,1,992,2)
+75 SET DIKZ(70)=$GET(^DGPT(DA,70))
+76 SET X=$PIECE($GET(DIKZ(70)),U,23)
+77 IF X'=""
XECUTE ^DD(45,79.23,1,992,2)
+78 SET DIKZ(70)=$GET(^DGPT(DA,70))
+79 SET X=$PIECE($GET(DIKZ(70)),U,24)
+80 IF X'=""
XECUTE ^DD(45,79.24,1,992,2)
+81 SET DIKZ(71)=$GET(^DGPT(DA,71))
+82 SET X=$PIECE($GET(DIKZ(71)),U,1)
+83 IF X'=""
XECUTE ^DD(45,79.241,1,1,2)
+84 SET DIKZ(71)=$GET(^DGPT(DA,71))
+85 SET X=$PIECE($GET(DIKZ(71)),U,2)
+86 IF X'=""
XECUTE ^DD(45,79.242,1,1,2)
+87 SET DIKZ(71)=$GET(^DGPT(DA,71))
+88 SET X=$PIECE($GET(DIKZ(71)),U,3)
+89 IF X'=""
XECUTE ^DD(45,79.243,1,1,2)
+90 SET DIKZ(71)=$GET(^DGPT(DA,71))
+91 SET X=$PIECE($GET(DIKZ(71)),U,4)
+92 IF X'=""
XECUTE ^DD(45,79.244,1,1,2)
+93 SET DIKZ(70)=$GET(^DGPT(DA,70))
+94 SET X=$PIECE($GET(DIKZ(70)),U,11)
+95 IF X'=""
XECUTE ^DD(45,80,1,992,2)
+96 SET DIKZ(0)=$GET(^DGPT(DA,0))
+97 SET X=$PIECE($GET(DIKZ(0)),U,1)
+98 IF X'=""
KILL ^DGPT("B",$EXTRACT(X,1,30),DA)
+99 SET X=$PIECE($GET(DIKZ(0)),U,1)
+100 IF X'=""
XECUTE ^DD(45,.01,1,2,2)
CR1 SET DIXR=366
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(70)=$GET(^DGPT(DA,70))
+7 SET X(4)=$PIECE(DIKZ(70),U,16)
+8 SET X(5)=$PIECE(DIKZ(70),U,1)
+9 SET X=$GET(X(1))
+10 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+11 KILL X1,X2
MERGE X1=X,X2=X
+12 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+13 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD1")
End DoDot:1
CR2 SET DIXR=367
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(71)=$GET(^DGPT(DA,71))
+7 SET X(4)=$PIECE(DIKZ(71),U,1)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
+11 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+12 KILL X1,X2
MERGE X1=X,X2=X
+13 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+14 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD10")
End DoDot:1
CR3 SET DIXR=368
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(71)=$GET(^DGPT(DA,71))
+7 SET X(4)=$PIECE(DIKZ(71),U,2)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
+11 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+12 KILL X1,X2
MERGE X1=X,X2=X
+13 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+14 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD11")
End DoDot:1
CR4 SET DIXR=369
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(71)=$GET(^DGPT(DA,71))
+7 SET X(4)=$PIECE(DIKZ(71),U,3)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
+11 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+12 KILL X1,X2
MERGE X1=X,X2=X
+13 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+14 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD12")
End DoDot:1
CR5 SET DIXR=370
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(71)=$GET(^DGPT(DA,71))
+7 SET X(4)=$PIECE(DIKZ(71),U,4)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
+11 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+12 KILL X1,X2
MERGE X1=X,X2=X
+13 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+14 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD13")
End DoDot:1
CR6 SET DIXR=371
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(70)=$GET(^DGPT(DA,70))
+7 SET X(4)=$PIECE(DIKZ(70),U,17)
+8 SET X(5)=$PIECE(DIKZ(70),U,1)
+9 SET X=$GET(X(1))
+10 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+11 KILL X1,X2
MERGE X1=X,X2=X
+12 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+13 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD2")
End DoDot:1
CR7 SET DIXR=372
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(70)=$GET(^DGPT(DA,70))
+7 SET X(4)=$PIECE(DIKZ(70),U,18)
+8 SET X(5)=$PIECE(DIKZ(70),U,1)
+9 SET X=$GET(X(1))
+10 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+11 KILL X1,X2
MERGE X1=X,X2=X
+12 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+13 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD3")
End DoDot:1
CR8 SET DIXR=373
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(70)=$GET(^DGPT(DA,70))
+7 SET X(4)=$PIECE(DIKZ(70),U,19)
+8 SET X(5)=$PIECE(DIKZ(70),U,1)
+9 SET X=$GET(X(1))
+10 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+11 KILL X1,X2
MERGE X1=X,X2=X
+12 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+13 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD4")
End DoDot:1
CR9 SET DIXR=374
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(70)=$GET(^DGPT(DA,70))
+7 SET X(4)=$PIECE(DIKZ(70),U,20)
+8 SET X(5)=$PIECE(DIKZ(70),U,1)
+9 SET X=$GET(X(1))
+10 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+11 KILL X1,X2
MERGE X1=X,X2=X
+12 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+13 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD5")
End DoDot:1
CR10 SET DIXR=375
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(70)=$GET(^DGPT(DA,70))
+7 SET X(4)=$PIECE(DIKZ(70),U,21)
+8 SET X(5)=$PIECE(DIKZ(70),U,1)
+9 SET X=$GET(X(1))
+10 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+11 KILL X1,X2
MERGE X1=X,X2=X
+12 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+13 DO KDGPT9D^DGPTDDCR(.X,.DA,"D SD6")
End DoDot:1
CR11 SET DIXR=376
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
END GOTO ^DGPTXX2
