DGPTXX1 ; COMPILED XREF FOR FILE #45 ; 02/01/23
;
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'="" N DGFDA,DGMSG S DGFDA(45.02,"1,"_$$IENS^DILF(DA),10)="@" D FILE^DIE("","DGFDA","DGMSG") K DGFDA,DGMSG
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)) N DGFDA,DGMSG S DGFDA(45.02,"1,"_$$IENS^DILF(DA),2)="@" D FILE^DIE("","DGFDA","DGMSG") K DGFDA,DGMSG
S X=$P($G(DIKZ(70)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,1)=DIV,DIH=45,DIG=82.01 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,2)=DIV,DIH=45,DIG=82.02 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,3)=DIV,DIH=45,DIG=82.03 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,4)=DIV,DIH=45,DIG=82.04 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,5)=DIV,DIH=45,DIG=82.05 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,6)=DIV,DIH=45,DIG=82.06 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,7)=DIV,DIH=45,DIG=82.07 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,8)=DIV,DIH=45,DIG=82.08 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,9)=DIV,DIH=45,DIG=82.09 D ^DICR
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'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,10)=DIV,DIH=45,DIG=82.1 D ^DICR
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 X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,11)=DIV,DIH=45,DIG=82.11 D ^DICR
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 X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,12)=DIV,DIH=45,DIG=82.12 D ^DICR
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 X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,13)=DIV,DIH=45,DIG=82.13 D ^DICR
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 X=$P($G(DIKZ(71)),U,4)
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,82)):^(82),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,14)=DIV,DIH=45,DIG=82.14 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,5)
I X'="" X ^DD(45,79.245,1,1,2)
S X=$P($G(DIKZ(71)),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,82)):^(82),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,15)=DIV,DIH=45,DIG=82.15 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,6)
I X'="" X ^DD(45,79.246,1,1,2)
S X=$P($G(DIKZ(71)),U,6)
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,82)):^(82),1:"") S X=$P(Y(1),U,16),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,16)=DIV,DIH=45,DIG=82.16 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,7)
I X'="" X ^DD(45,79.247,1,1,2)
S X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,17),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,17)=DIV,DIH=45,DIG=82.17 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,8)
I X'="" X ^DD(45,79.248,1,1,2)
S X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,18),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,18)=DIV,DIH=45,DIG=82.18 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,9)
I X'="" X ^DD(45,79.249,1,1,2)
S X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,19),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,19)=DIV,DIH=45,DIG=82.19 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,10)
I X'="" X ^DD(45,79.2491,1,1,2)
S X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,20)=DIV,DIH=45,DIG=82.2 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,11)
I X'="" X ^DD(45,79.24911,1,1,2)
S X=$P($G(DIKZ(71)),U,11)
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,82)):^(82),1:"") S X=$P(Y(1),U,21),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,21)=DIV,DIH=45,DIG=82.21 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,12)
I X'="" X ^DD(45,79.24912,1,1,2)
S X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,22),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,22)=DIV,DIH=45,DIG=82.22 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,13)
I X'="" X ^DD(45,79.24913,1,1,2)
S X=$P($G(DIKZ(71)),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,82)):^(82),1:"") S X=$P(Y(1),U,23),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,23)=DIV,DIH=45,DIG=82.23 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,14)
I X'="" X ^DD(45,79.24914,1,1,2)
S X=$P($G(DIKZ(71)),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(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,24),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,24)=DIV,DIH=45,DIG=82.24 D ^DICR
S DIKZ(71)=$G(^DGPT(DA,71))
S X=$P($G(DIKZ(71)),U,15)
I X'="" X ^DD(45,79.24915,1,1,2)
S X=$P($G(DIKZ(71)),U,15)
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,82)):^(82),1:"") S X=$P(Y(1),U,25),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,25)=DIV,DIH=45,DIG=82.25 D ^DICR
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)
CR1 S DIXR=401
K X
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,11)
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 KPTFDD^DGPTDDCR(.X,.DA,"PDX")
CR2 S DIXR=833
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,11)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(3)=$P(DIKZ(70),U,10)
S X(4)=$P(DIKZ(70),U,16)
S X(5)=$P(DIKZ(70),U,17)
S X(6)=$P(DIKZ(70),U,18)
S X(7)=$P(DIKZ(70),U,19)
S X(8)=$P(DIKZ(70),U,20)
S X(9)=$P(DIKZ(70),U,21)
S X(10)=$P(DIKZ(70),U,22)
S X(11)=$P(DIKZ(70),U,23)
S X(12)=$P(DIKZ(70),U,24)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(13)=$P(DIKZ(71),U,1)
S X(14)=$P(DIKZ(71),U,2)
S X(15)=$P(DIKZ(71),U,3)
S X(16)=$P(DIKZ(71),U,4)
S X(17)=$P(DIKZ(71),U,5)
S X(18)=$P(DIKZ(71),U,6)
S X(19)=$P(DIKZ(71),U,7)
S X(20)=$P(DIKZ(71),U,8)
S X(21)=$P(DIKZ(71),U,9)
S X(22)=$P(DIKZ(71),U,10)
S X(23)=$P(DIKZ(71),U,11)
S X(24)=$P(DIKZ(71),U,12)
S X(25)=$P(DIKZ(71),U,13)
S X(26)=$P(DIKZ(71),U,14)
S X(27)=$P(DIKZ(71),U,15)
S X(28)=$P(DIKZ(70),U,11)
S X=$G(X(1))
D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5),X2(6),X2(7),X2(8),X2(9),X2(10),X2(11),X2(12),X2(13),X2(14),X2(15),X2(16),X2(17),X2(18),X2(19),X2(20),X2(21),X2(22),X2(23),X2(24),X2(25),X2(26),X2(27),X2(28))=""
. D NOTIFY^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","KILL")
CR3 S DIXR=1176
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,10)
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 KPTFDD^DGPTDDCR(.X,.DA,"DXLS")
CR4 S DIXR=1187
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD1")
CR5 S DIXR=1188
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD10")
CR6 S DIXR=1189
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD11")
CR7 S DIXR=1190
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD12")
CR8 S DIXR=1191
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD13")
CR9 S DIXR=1192
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD2")
CR10 S DIXR=1193
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD3")
CR11 S DIXR=1194
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD4")
CR12 S DIXR=1195
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD5")
CR13 S DIXR=1196
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD6")
CR14 S DIXR=1197
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,22)
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD7")
CR15 S DIXR=1198
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,23)
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD8")
CR16 S DIXR=1199
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,24)
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD9")
CR17 S DIXR=1239
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,5)
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD14")
CR18 S DIXR=1240
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,6)
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD15")
CR19 S DIXR=1241
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,7)
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 KPTFDD^DGPTDDCR(.X,.DA,"D SD16")
CR20 S DIXR=1242
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,8)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
END G ^DGPTXX2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTXX1 19852 printed Apr 09, 2024@21:57:17 Page 2
DGPTXX1 ; COMPILED XREF FOR FILE #45 ; 02/01/23
+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'=""
NEW DGFDA,DGMSG
SET DGFDA(45.02,"1,"_$$IENS^DILF(DA),10)="@"
DO FILE^DIE("","DGFDA","DGMSG")
KILL DGFDA,DGMSG
+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))
NEW DGFDA,DGMSG
SET DGFDA(45.02,"1,"_$$IENS^DILF(DA),2)="@"
DO FILE^DIE("","DGFDA","DGMSG")
KILL DGFDA,DGMSG
+52 SET X=$PIECE($GET(DIKZ(70)),U,10)
+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(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,1)=DIV
SET DIH=45
SET DIG=82.01
DO ^DICR
End DoDot:1
+56 SET X=$PIECE($GET(DIKZ(70)),U,10)
+57 IF X'=""
XECUTE ^DD(45,79,1,992,2)
+58 SET DIKZ(70)=$GET(^DGPT(DA,70))
+59 SET X=$PIECE($GET(DIKZ(70)),U,16)
+60 IF X'=""
Begin DoDot:1
+61 NEW DIK,DIV,DIU,DIN
+62 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,2)=DIV
SET DIH=45
SET DIG=82.02
DO ^DICR
End DoDot:1
+63 SET X=$PIECE($GET(DIKZ(70)),U,16)
+64 IF X'=""
XECUTE ^DD(45,79.16,1,992,2)
+65 SET DIKZ(70)=$GET(^DGPT(DA,70))
+66 SET X=$PIECE($GET(DIKZ(70)),U,17)
+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(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,3)=DIV
SET DIH=45
SET DIG=82.03
DO ^DICR
End DoDot:1
+70 SET X=$PIECE($GET(DIKZ(70)),U,17)
+71 IF X'=""
XECUTE ^DD(45,79.17,1,992,2)
+72 SET DIKZ(70)=$GET(^DGPT(DA,70))
+73 SET X=$PIECE($GET(DIKZ(70)),U,18)
+74 IF X'=""
Begin DoDot:1
+75 NEW DIK,DIV,DIU,DIN
+76 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,4)=DIV
SET DIH=45
SET DIG=82.04
DO ^DICR
End DoDot:1
+77 SET X=$PIECE($GET(DIKZ(70)),U,18)
+78 IF X'=""
XECUTE ^DD(45,79.18,1,992,2)
+79 SET DIKZ(70)=$GET(^DGPT(DA,70))
+80 SET X=$PIECE($GET(DIKZ(70)),U,19)
+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(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,5)=DIV
SET DIH=45
SET DIG=82.05
DO ^DICR
End DoDot:1
+84 SET X=$PIECE($GET(DIKZ(70)),U,19)
+85 IF X'=""
XECUTE ^DD(45,79.19,1,992,2)
+86 SET DIKZ(70)=$GET(^DGPT(DA,70))
+87 SET X=$PIECE($GET(DIKZ(70)),U,20)
+88 IF X'=""
Begin DoDot:1
+89 NEW DIK,DIV,DIU,DIN
+90 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,6)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,6)=DIV
SET DIH=45
SET DIG=82.06
DO ^DICR
End DoDot:1
+91 SET X=$PIECE($GET(DIKZ(70)),U,20)
+92 IF X'=""
XECUTE ^DD(45,79.201,1,992,2)
+93 SET DIKZ(70)=$GET(^DGPT(DA,70))
+94 SET X=$PIECE($GET(DIKZ(70)),U,21)
+95 IF X'=""
Begin DoDot:1
+96 NEW DIK,DIV,DIU,DIN
+97 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,7)=DIV
SET DIH=45
SET DIG=82.07
DO ^DICR
End DoDot:1
+98 SET X=$PIECE($GET(DIKZ(70)),U,21)
+99 IF X'=""
XECUTE ^DD(45,79.21,1,992,2)
+100 SET DIKZ(70)=$GET(^DGPT(DA,70))
+101 SET X=$PIECE($GET(DIKZ(70)),U,22)
+102 IF X'=""
Begin DoDot:1
+103 NEW DIK,DIV,DIU,DIN
+104 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,8)=DIV
SET DIH=45
SET DIG=82.08
DO ^DICR
End DoDot:1
+105 SET X=$PIECE($GET(DIKZ(70)),U,22)
+106 IF X'=""
XECUTE ^DD(45,79.22,1,992,2)
+107 SET DIKZ(70)=$GET(^DGPT(DA,70))
+108 SET X=$PIECE($GET(DIKZ(70)),U,23)
+109 IF X'=""
Begin DoDot:1
+110 NEW DIK,DIV,DIU,DIN
+111 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,9)=DIV
SET DIH=45
SET DIG=82.09
DO ^DICR
End DoDot:1
+112 SET X=$PIECE($GET(DIKZ(70)),U,23)
+113 IF X'=""
XECUTE ^DD(45,79.23,1,992,2)
+114 SET DIKZ(70)=$GET(^DGPT(DA,70))
+115 SET X=$PIECE($GET(DIKZ(70)),U,24)
+116 IF X'=""
Begin DoDot:1
+117 NEW DIK,DIV,DIU,DIN
+118 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,10)=DIV
SET DIH=45
SET DIG=82.1
DO ^DICR
End DoDot:1
+119 SET X=$PIECE($GET(DIKZ(70)),U,24)
+120 IF X'=""
XECUTE ^DD(45,79.24,1,992,2)
+121 SET DIKZ(71)=$GET(^DGPT(DA,71))
+122 SET X=$PIECE($GET(DIKZ(71)),U,1)
+123 IF X'=""
XECUTE ^DD(45,79.241,1,1,2)
+124 SET X=$PIECE($GET(DIKZ(71)),U,1)
+125 IF X'=""
Begin DoDot:1
+126 NEW DIK,DIV,DIU,DIN
+127 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,11)=DIV
SET DIH=45
SET DIG=82.11
DO ^DICR
End DoDot:1
+128 SET DIKZ(71)=$GET(^DGPT(DA,71))
+129 SET X=$PIECE($GET(DIKZ(71)),U,2)
+130 IF X'=""
XECUTE ^DD(45,79.242,1,1,2)
+131 SET X=$PIECE($GET(DIKZ(71)),U,2)
+132 IF X'=""
Begin DoDot:1
+133 NEW DIK,DIV,DIU,DIN
+134 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,12)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,12)=DIV
SET DIH=45
SET DIG=82.12
DO ^DICR
End DoDot:1
+135 SET DIKZ(71)=$GET(^DGPT(DA,71))
+136 SET X=$PIECE($GET(DIKZ(71)),U,3)
+137 IF X'=""
XECUTE ^DD(45,79.243,1,1,2)
+138 SET X=$PIECE($GET(DIKZ(71)),U,3)
+139 IF X'=""
Begin DoDot:1
+140 NEW DIK,DIV,DIU,DIN
+141 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,13)=DIV
SET DIH=45
SET DIG=82.13
DO ^DICR
End DoDot:1
+142 SET DIKZ(71)=$GET(^DGPT(DA,71))
+143 SET X=$PIECE($GET(DIKZ(71)),U,4)
+144 IF X'=""
XECUTE ^DD(45,79.244,1,1,2)
+145 SET X=$PIECE($GET(DIKZ(71)),U,4)
+146 IF X'=""
Begin DoDot:1
+147 NEW DIK,DIV,DIU,DIN
+148 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,14)=DIV
SET DIH=45
SET DIG=82.14
DO ^DICR
End DoDot:1
+149 SET DIKZ(71)=$GET(^DGPT(DA,71))
+150 SET X=$PIECE($GET(DIKZ(71)),U,5)
+151 IF X'=""
XECUTE ^DD(45,79.245,1,1,2)
+152 SET X=$PIECE($GET(DIKZ(71)),U,5)
+153 IF X'=""
Begin DoDot:1
+154 NEW DIK,DIV,DIU,DIN
+155 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,15)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,15)=DIV
SET DIH=45
SET DIG=82.15
DO ^DICR
End DoDot:1
+156 SET DIKZ(71)=$GET(^DGPT(DA,71))
+157 SET X=$PIECE($GET(DIKZ(71)),U,6)
+158 IF X'=""
XECUTE ^DD(45,79.246,1,1,2)
+159 SET X=$PIECE($GET(DIKZ(71)),U,6)
+160 IF X'=""
Begin DoDot:1
+161 NEW DIK,DIV,DIU,DIN
+162 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,16)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,16)=DIV
SET DIH=45
SET DIG=82.16
DO ^DICR
End DoDot:1
+163 SET DIKZ(71)=$GET(^DGPT(DA,71))
+164 SET X=$PIECE($GET(DIKZ(71)),U,7)
+165 IF X'=""
XECUTE ^DD(45,79.247,1,1,2)
+166 SET X=$PIECE($GET(DIKZ(71)),U,7)
+167 IF X'=""
Begin DoDot:1
+168 NEW DIK,DIV,DIU,DIN
+169 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,17)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,17)=DIV
SET DIH=45
SET DIG=82.17
DO ^DICR
End DoDot:1
+170 SET DIKZ(71)=$GET(^DGPT(DA,71))
+171 SET X=$PIECE($GET(DIKZ(71)),U,8)
+172 IF X'=""
XECUTE ^DD(45,79.248,1,1,2)
+173 SET X=$PIECE($GET(DIKZ(71)),U,8)
+174 IF X'=""
Begin DoDot:1
+175 NEW DIK,DIV,DIU,DIN
+176 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,18)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,18)=DIV
SET DIH=45
SET DIG=82.18
DO ^DICR
End DoDot:1
+177 SET DIKZ(71)=$GET(^DGPT(DA,71))
+178 SET X=$PIECE($GET(DIKZ(71)),U,9)
+179 IF X'=""
XECUTE ^DD(45,79.249,1,1,2)
+180 SET X=$PIECE($GET(DIKZ(71)),U,9)
+181 IF X'=""
Begin DoDot:1
+182 NEW DIK,DIV,DIU,DIN
+183 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,19)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,19)=DIV
SET DIH=45
SET DIG=82.19
DO ^DICR
End DoDot:1
+184 SET DIKZ(71)=$GET(^DGPT(DA,71))
+185 SET X=$PIECE($GET(DIKZ(71)),U,10)
+186 IF X'=""
XECUTE ^DD(45,79.2491,1,1,2)
+187 SET X=$PIECE($GET(DIKZ(71)),U,10)
+188 IF X'=""
Begin DoDot:1
+189 NEW DIK,DIV,DIU,DIN
+190 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,20)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,20)=DIV
SET DIH=45
SET DIG=82.2
DO ^DICR
End DoDot:1
+191 SET DIKZ(71)=$GET(^DGPT(DA,71))
+192 SET X=$PIECE($GET(DIKZ(71)),U,11)
+193 IF X'=""
XECUTE ^DD(45,79.24911,1,1,2)
+194 SET X=$PIECE($GET(DIKZ(71)),U,11)
+195 IF X'=""
Begin DoDot:1
+196 NEW DIK,DIV,DIU,DIN
+197 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,21)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,21)=DIV
SET DIH=45
SET DIG=82.21
DO ^DICR
End DoDot:1
+198 SET DIKZ(71)=$GET(^DGPT(DA,71))
+199 SET X=$PIECE($GET(DIKZ(71)),U,12)
+200 IF X'=""
XECUTE ^DD(45,79.24912,1,1,2)
+201 SET X=$PIECE($GET(DIKZ(71)),U,12)
+202 IF X'=""
Begin DoDot:1
+203 NEW DIK,DIV,DIU,DIN
+204 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,22)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,22)=DIV
SET DIH=45
SET DIG=82.22
DO ^DICR
End DoDot:1
+205 SET DIKZ(71)=$GET(^DGPT(DA,71))
+206 SET X=$PIECE($GET(DIKZ(71)),U,13)
+207 IF X'=""
XECUTE ^DD(45,79.24913,1,1,2)
+208 SET X=$PIECE($GET(DIKZ(71)),U,13)
+209 IF X'=""
Begin DoDot:1
+210 NEW DIK,DIV,DIU,DIN
+211 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,23)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,23)=DIV
SET DIH=45
SET DIG=82.23
DO ^DICR
End DoDot:1
+212 SET DIKZ(71)=$GET(^DGPT(DA,71))
+213 SET X=$PIECE($GET(DIKZ(71)),U,14)
+214 IF X'=""
XECUTE ^DD(45,79.24914,1,1,2)
+215 SET X=$PIECE($GET(DIKZ(71)),U,14)
+216 IF X'=""
Begin DoDot:1
+217 NEW DIK,DIV,DIU,DIN
+218 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,24)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,24)=DIV
SET DIH=45
SET DIG=82.24
DO ^DICR
End DoDot:1
+219 SET DIKZ(71)=$GET(^DGPT(DA,71))
+220 SET X=$PIECE($GET(DIKZ(71)),U,15)
+221 IF X'=""
XECUTE ^DD(45,79.24915,1,1,2)
+222 SET X=$PIECE($GET(DIKZ(71)),U,15)
+223 IF X'=""
Begin DoDot:1
+224 NEW DIK,DIV,DIU,DIN
+225 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,25)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,25)=DIV
SET DIH=45
SET DIG=82.25
DO ^DICR
End DoDot:1
+226 SET DIKZ(70)=$GET(^DGPT(DA,70))
+227 SET X=$PIECE($GET(DIKZ(70)),U,11)
+228 IF X'=""
XECUTE ^DD(45,80,1,992,2)
+229 SET DIKZ(0)=$GET(^DGPT(DA,0))
+230 SET X=$PIECE($GET(DIKZ(0)),U,1)
+231 IF X'=""
KILL ^DGPT("B",$EXTRACT(X,1,30),DA)
CR1 SET DIXR=401
+1 KILL X
+2 SET X(1)=$PIECE(DIKZ(0),U,1)
+3 SET X(2)=$PIECE(DIKZ(0),U,2)
+4 SET X(3)=$PIECE(DIKZ(0),U,11)
+5 SET DIKZ(70)=$GET(^DGPT(DA,70))
+6 SET X(4)=$PIECE(DIKZ(70),U,11)
+7 SET X(5)=$PIECE(DIKZ(70),U,1)
+8 SET X=$GET(X(1))
+9 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+10 KILL X1,X2
MERGE X1=X,X2=X
+11 if $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
+12 DO KPTFDD^DGPTDDCR(.X,.DA,"PDX")
End DoDot:1
CR2 SET DIXR=833
+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,11)
+5 SET DIKZ(70)=$GET(^DGPT(DA,70))
+6 SET X(3)=$PIECE(DIKZ(70),U,10)
+7 SET X(4)=$PIECE(DIKZ(70),U,16)
+8 SET X(5)=$PIECE(DIKZ(70),U,17)
+9 SET X(6)=$PIECE(DIKZ(70),U,18)
+10 SET X(7)=$PIECE(DIKZ(70),U,19)
+11 SET X(8)=$PIECE(DIKZ(70),U,20)
+12 SET X(9)=$PIECE(DIKZ(70),U,21)
+13 SET X(10)=$PIECE(DIKZ(70),U,22)
+14 SET X(11)=$PIECE(DIKZ(70),U,23)
+15 SET X(12)=$PIECE(DIKZ(70),U,24)
+16 SET DIKZ(71)=$GET(^DGPT(DA,71))
+17 SET X(13)=$PIECE(DIKZ(71),U,1)
+18 SET X(14)=$PIECE(DIKZ(71),U,2)
+19 SET X(15)=$PIECE(DIKZ(71),U,3)
+20 SET X(16)=$PIECE(DIKZ(71),U,4)
+21 SET X(17)=$PIECE(DIKZ(71),U,5)
+22 SET X(18)=$PIECE(DIKZ(71),U,6)
+23 SET X(19)=$PIECE(DIKZ(71),U,7)
+24 SET X(20)=$PIECE(DIKZ(71),U,8)
+25 SET X(21)=$PIECE(DIKZ(71),U,9)
+26 SET X(22)=$PIECE(DIKZ(71),U,10)
+27 SET X(23)=$PIECE(DIKZ(71),U,11)
+28 SET X(24)=$PIECE(DIKZ(71),U,12)
+29 SET X(25)=$PIECE(DIKZ(71),U,13)
+30 SET X(26)=$PIECE(DIKZ(71),U,14)
+31 SET X(27)=$PIECE(DIKZ(71),U,15)
+32 SET X(28)=$PIECE(DIKZ(70),U,11)
+33 SET X=$GET(X(1))
+34 Begin DoDot:1
+35 KILL X1,X2
MERGE X1=X,X2=X
+36 if $DATA(DIKIL)
SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5),X2(6),X2(7),X2(8),X2(9),X2(10),X2(11),X2(12),X2(13),X2(14),X2(15),X2(16),X2(17),X2(18),X2(19),X2(20),X2(21),X2(22),X2(23),X2(24),X2(25),X2(26),X2(27),X2(28))=""
+37 DO NOTIFY^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","KILL")
End DoDot:1
CR3 SET DIXR=1176
+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,10)
+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 KPTFDD^DGPTDDCR(.X,.DA,"DXLS")
End DoDot:1
CR4 SET DIXR=1187
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD1")
End DoDot:1
CR5 SET DIXR=1188
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD10")
End DoDot:1
CR6 SET DIXR=1189
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD11")
End DoDot:1
CR7 SET DIXR=1190
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD12")
End DoDot:1
CR8 SET DIXR=1191
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD13")
End DoDot:1
CR9 SET DIXR=1192
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD2")
End DoDot:1
CR10 SET DIXR=1193
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD3")
End DoDot:1
CR11 SET DIXR=1194
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD4")
End DoDot:1
CR12 SET DIXR=1195
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD5")
End DoDot:1
CR13 SET DIXR=1196
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD6")
End DoDot:1
CR14 SET DIXR=1197
+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,22)
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD7")
End DoDot:1
CR15 SET DIXR=1198
+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,23)
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD8")
End DoDot:1
CR16 SET DIXR=1199
+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,24)
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD9")
End DoDot:1
CR17 SET DIXR=1239
+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,5)
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD14")
End DoDot:1
CR18 SET DIXR=1240
+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,6)
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD15")
End DoDot:1
CR19 SET DIXR=1241
+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,7)
+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 KPTFDD^DGPTDDCR(.X,.DA,"D SD16")
End DoDot:1
CR20 SET DIXR=1242
+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,8)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
END GOTO ^DGPTXX2
