DGPTXX11 ; COMPILED XREF FOR FILE #45.02 ; 10/30/24
;
S DA=0
A1 ;
I $D(DISET) K DIKLM S:DIKM1=1 DIKLM=1 G @DIKM1
0 ;
A S DA=$O(^DGPT(DA(1),"M",DA)) I DA'>0 S DA=0 G END
1 ;
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,0)):^(0),1:"") S X=$P(Y(1),U,16),X=X S DIU=X K Y X ^DD(45.02,2,1,1,1.1) X ^DD(45.02,2,1,1,1.4)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,5)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,5)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,1)=DIV,DIH=45.02,DIG=82.01 D ^DICR
S X=$P($G(DIKZ(0)),U,5)
I X'="" X ^DD(45.02,5,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,6)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,2)=DIV,DIH=45.02,DIG=82.02 D ^DICR
S X=$P($G(DIKZ(0)),U,6)
I X'="" X ^DD(45.02,6,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,7)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,7)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,3)=DIV,DIH=45.02,DIG=82.03 D ^DICR
S X=$P($G(DIKZ(0)),U,7)
I X'="" X ^DD(45.02,7,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,8)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,8)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,4)=DIV,DIH=45.02,DIG=82.04 D ^DICR
S X=$P($G(DIKZ(0)),U,8)
I X'="" X ^DD(45.02,8,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,9)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,5)=DIV,DIH=45.02,DIG=82.05 D ^DICR
S X=$P($G(DIKZ(0)),U,9)
I X'="" X ^DD(45.02,9,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,10)
I X'="" S ^DGPT(DA(1),"M","AM",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,11)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,11)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,6)=DIV,DIH=45.02,DIG=82.06 D ^DICR
S X=$P($G(DIKZ(0)),U,11)
I X'="" X ^DD(45.02,11,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,12)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,12)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,7)=DIV,DIH=45.02,DIG=82.07 D ^DICR
S X=$P($G(DIKZ(0)),U,12)
I X'="" X ^DD(45.02,12,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,13)
I X'="" S ^DGPT(DA(1),"M","AC",$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(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,8)=DIV,DIH=45.02,DIG=82.08 D ^DICR
S X=$P($G(DIKZ(0)),U,13)
I X'="" X ^DD(45.02,13,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,14)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,14)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,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),"M",DIV(1),82)),DIV=X S $P(^(82),U,9)=DIV,DIH=45.02,DIG=82.09 D ^DICR
S X=$P($G(DIKZ(0)),U,14)
I X'="" X ^DD(45.02,14,1,992,1)
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X=$P($G(DIKZ(0)),U,15)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,15)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X="" X ^DD(45.02,15,1,2,1.4)
S X=$P($G(DIKZ(0)),U,15)
I X'="" X ^DD(45.02,15,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,1)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,1)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X="" X ^DD(45.02,81.01,1,2,1.4)
S X=$P($G(DIKZ(81)),U,1)
I X'="" X ^DD(45.02,81.01,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,2)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X="" X ^DD(45.02,81.02,1,2,1.4)
S X=$P($G(DIKZ(81)),U,2)
I X'="" X ^DD(45.02,81.02,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,3)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X="" X ^DD(45.02,81.03,1,2,1.4)
S X=$P($G(DIKZ(81)),U,3)
I X'="" X ^DD(45.02,81.03,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,4)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X="" X ^DD(45.02,81.04,1,2,1.4)
S X=$P($G(DIKZ(81)),U,4)
I X'="" X ^DD(45.02,81.04,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,5)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,5)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" X ^DD(45.02,81.05,1,2,1.4)
S X=$P($G(DIKZ(81)),U,5)
I X'="" X ^DD(45.02,81.05,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,6)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,16),X=X S DIU=X K Y S X="" X ^DD(45.02,81.06,1,2,1.4)
S X=$P($G(DIKZ(81)),U,6)
I X'="" X ^DD(45.02,81.06,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,7)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,7)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,17),X=X S DIU=X K Y S X="" X ^DD(45.02,81.07,1,2,1.4)
S X=$P($G(DIKZ(81)),U,7)
I X'="" X ^DD(45.02,81.07,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,8)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,8)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,18),X=X S DIU=X K Y S X="" X ^DD(45.02,81.08,1,2,1.4)
S X=$P($G(DIKZ(81)),U,8)
I X'="" X ^DD(45.02,81.08,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,9)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,9)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,19),X=X S DIU=X K Y S X="" X ^DD(45.02,81.09,1,2,1.4)
S X=$P($G(DIKZ(81)),U,9)
I X'="" X ^DD(45.02,81.09,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,10)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,10)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(45.02,81.1,1,2,1.4)
S X=$P($G(DIKZ(81)),U,10)
I X'="" X ^DD(45.02,81.1,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,11)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,11)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,21),X=X S DIU=X K Y S X="" X ^DD(45.02,81.11,1,2,1.4)
S X=$P($G(DIKZ(81)),U,11)
I X'="" X ^DD(45.02,81.11,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,12)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,12)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,22),X=X S DIU=X K Y S X="" X ^DD(45.02,81.12,1,2,1.4)
S X=$P($G(DIKZ(81)),U,12)
I X'="" X ^DD(45.02,81.12,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,13)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,13)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,23),X=X S DIU=X K Y S X="" X ^DD(45.02,81.13,1,2,1.4)
S X=$P($G(DIKZ(81)),U,13)
I X'="" X ^DD(45.02,81.13,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,14)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,14)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,24),X=X S DIU=X K Y S X="" X ^DD(45.02,81.14,1,2,1.4)
S X=$P($G(DIKZ(81)),U,14)
I X'="" X ^DD(45.02,81.14,1,992,1)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X=$P($G(DIKZ(81)),U,15)
I X'="" S ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(81)),U,15)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,82)):^(82),1:"") S X=$P(Y(1),U,25),X=X S DIU=X K Y S X="" X ^DD(45.02,81.15,1,2,1.4)
S X=$P($G(DIKZ(81)),U,15)
I X'="" X ^DD(45.02,81.15,1,992,1)
CR1 S DIXR=835
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,5)
S X(3)=$P(DIKZ(0),U,6)
S X(4)=$P(DIKZ(0),U,7)
S X(5)=$P(DIKZ(0),U,8)
S X(6)=$P(DIKZ(0),U,9)
S X(7)=$P(DIKZ(0),U,11)
S X(8)=$P(DIKZ(0),U,12)
S X(9)=$P(DIKZ(0),U,13)
S X(10)=$P(DIKZ(0),U,14)
S X(11)=$P(DIKZ(0),U,15)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(12)=$P(DIKZ(81),U,1)
S X(13)=$P(DIKZ(81),U,2)
S X(14)=$P(DIKZ(81),U,3)
S X(15)=$P(DIKZ(81),U,4)
S X(16)=$P(DIKZ(81),U,5)
S X(17)=$P(DIKZ(81),U,6)
S X(18)=$P(DIKZ(81),U,7)
S X(19)=$P(DIKZ(81),U,8)
S X(20)=$P(DIKZ(81),U,9)
S X(21)=$P(DIKZ(81),U,10)
S X(22)=$P(DIKZ(81),U,11)
S X(23)=$P(DIKZ(81),U,12)
S X(24)=$P(DIKZ(81),U,13)
S X(25)=$P(DIKZ(81),U,14)
S X(26)=$P(DIKZ(81),U,15)
S X=$G(X(1))
D
. K X1,X2 M X1=X,X2=X
. D NOTIFY^DGPTDD(.X1,.X2,.DA,45,"MOVEMENT","SET")
CR2 S DIXR=1177
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,5)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD1")
CR3 S DIXR=1178
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,15)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD10")
CR4 S DIXR=1179
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,6)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD2")
CR5 S DIXR=1180
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,7)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD3")
CR6 S DIXR=1181
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,8)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD4")
CR7 S DIXR=1182
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,9)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD5")
CR8 S DIXR=1183
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,11)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD6")
CR9 S DIXR=1184
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,12)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD7")
CR10 S DIXR=1185
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,13)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD8")
CR11 S DIXR=1186
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S X(2)=$P(DIKZ(0),U,14)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD9")
CR12 S DIXR=1224
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,1)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD11")
CR13 S DIXR=1225
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,2)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD12")
CR14 S DIXR=1226
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,3)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD13")
CR15 S DIXR=1227
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,4)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD14")
CR16 S DIXR=1228
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,5)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD15")
CR17 S DIXR=1229
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,6)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD16")
CR18 S DIXR=1230
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,7)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD17")
CR19 S DIXR=1231
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,8)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD18")
CR20 S DIXR=1232
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,9)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD19")
CR21 S DIXR=1233
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,10)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD20")
CR22 S DIXR=1234
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,11)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD21")
CR23 S DIXR=1235
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,12)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD22")
CR24 S DIXR=1236
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,13)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD23")
CR25 S DIXR=1237
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,14)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD24")
CR26 S DIXR=1238
K X
S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
S X(1)=$P(DIKZ(0),U,10)
S DIKZ(81)=$G(^DGPT(DA(1),"M",DA,81))
S X(2)=$P(DIKZ(81),U,15)
S X=$G(X(1))
I $G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFMD^DGPTDDCR(.X,.DA,"M ICD25")
CR27 K X
G:'$D(DIKLM) A Q:$D(DISET)
END G ^DGPTXX12
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTXX11 18059 printed Feb 19, 2025@00:20:22 Page 2
DGPTXX11 ; COMPILED XREF FOR FILE #45.02 ; 10/30/24
+1 ;
+2 SET DA=0
A1 ;
+1 IF $DATA(DISET)
KILL DIKLM
if DIKM1=1
SET DIKLM=1
GOTO @DIKM1
0 ;
A SET DA=$ORDER(^DGPT(DA(1),"M",DA))
IF DA'>0
SET DA=0
GOTO END
1 ;
+1 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+2 SET X=$PIECE($GET(DIKZ(0)),U,2)
+3 IF X'=""
Begin DoDot:1
+4 NEW DIK,DIV,DIU,DIN
+5 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,16)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(45.02,2,1,1,1.1)
XECUTE ^DD(45.02,2,1,1,1.4)
End DoDot:1
+6 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+7 SET X=$PIECE($GET(DIKZ(0)),U,5)
+8 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+9 SET X=$PIECE($GET(DIKZ(0)),U,5)
+10 IF X'=""
Begin DoDot:1
+11 NEW DIK,DIV,DIU,DIN
+12 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,1)=DIV
SET DIH=45.02
SET DIG=82.01
DO ^DICR
End DoDot:1
+13 SET X=$PIECE($GET(DIKZ(0)),U,5)
+14 IF X'=""
XECUTE ^DD(45.02,5,1,992,1)
+15 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+16 SET X=$PIECE($GET(DIKZ(0)),U,6)
+17 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+18 SET X=$PIECE($GET(DIKZ(0)),U,6)
+19 IF X'=""
Begin DoDot:1
+20 NEW DIK,DIV,DIU,DIN
+21 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,2)=DIV
SET DIH=45.02
SET DIG=82.02
DO ^DICR
End DoDot:1
+22 SET X=$PIECE($GET(DIKZ(0)),U,6)
+23 IF X'=""
XECUTE ^DD(45.02,6,1,992,1)
+24 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+25 SET X=$PIECE($GET(DIKZ(0)),U,7)
+26 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+27 SET X=$PIECE($GET(DIKZ(0)),U,7)
+28 IF X'=""
Begin DoDot:1
+29 NEW DIK,DIV,DIU,DIN
+30 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,3)=DIV
SET DIH=45.02
SET DIG=82.03
DO ^DICR
End DoDot:1
+31 SET X=$PIECE($GET(DIKZ(0)),U,7)
+32 IF X'=""
XECUTE ^DD(45.02,7,1,992,1)
+33 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+34 SET X=$PIECE($GET(DIKZ(0)),U,8)
+35 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+36 SET X=$PIECE($GET(DIKZ(0)),U,8)
+37 IF X'=""
Begin DoDot:1
+38 NEW DIK,DIV,DIU,DIN
+39 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,4)=DIV
SET DIH=45.02
SET DIG=82.04
DO ^DICR
End DoDot:1
+40 SET X=$PIECE($GET(DIKZ(0)),U,8)
+41 IF X'=""
XECUTE ^DD(45.02,8,1,992,1)
+42 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+43 SET X=$PIECE($GET(DIKZ(0)),U,9)
+44 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+45 SET X=$PIECE($GET(DIKZ(0)),U,9)
+46 IF X'=""
Begin DoDot:1
+47 NEW DIK,DIV,DIU,DIN
+48 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,5)=DIV
SET DIH=45.02
SET DIG=82.05
DO ^DICR
End DoDot:1
+49 SET X=$PIECE($GET(DIKZ(0)),U,9)
+50 IF X'=""
XECUTE ^DD(45.02,9,1,992,1)
+51 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+52 SET X=$PIECE($GET(DIKZ(0)),U,10)
+53 IF X'=""
SET ^DGPT(DA(1),"M","AM",$EXTRACT(X,1,30),DA)=""
+54 SET X=$PIECE($GET(DIKZ(0)),U,11)
+55 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+56 SET X=$PIECE($GET(DIKZ(0)),U,11)
+57 IF X'=""
Begin DoDot:1
+58 NEW DIK,DIV,DIU,DIN
+59 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,6)=DIV
SET DIH=45.02
SET DIG=82.06
DO ^DICR
End DoDot:1
+60 SET X=$PIECE($GET(DIKZ(0)),U,11)
+61 IF X'=""
XECUTE ^DD(45.02,11,1,992,1)
+62 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+63 SET X=$PIECE($GET(DIKZ(0)),U,12)
+64 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+65 SET X=$PIECE($GET(DIKZ(0)),U,12)
+66 IF X'=""
Begin DoDot:1
+67 NEW DIK,DIV,DIU,DIN
+68 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,7)=DIV
SET DIH=45.02
SET DIG=82.07
DO ^DICR
End DoDot:1
+69 SET X=$PIECE($GET(DIKZ(0)),U,12)
+70 IF X'=""
XECUTE ^DD(45.02,12,1,992,1)
+71 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+72 SET X=$PIECE($GET(DIKZ(0)),U,13)
+73 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+74 SET X=$PIECE($GET(DIKZ(0)),U,13)
+75 IF X'=""
Begin DoDot:1
+76 NEW DIK,DIV,DIU,DIN
+77 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,8)=DIV
SET DIH=45.02
SET DIG=82.08
DO ^DICR
End DoDot:1
+78 SET X=$PIECE($GET(DIKZ(0)),U,13)
+79 IF X'=""
XECUTE ^DD(45.02,13,1,992,1)
+80 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+81 SET X=$PIECE($GET(DIKZ(0)),U,14)
+82 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+83 SET X=$PIECE($GET(DIKZ(0)),U,14)
+84 IF X'=""
Begin DoDot:1
+85 NEW DIK,DIV,DIU,DIN
+86 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,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),"M",DIV(1),82))
SET DIV=X
SET $PIECE(^(82),U,9)=DIV
SET DIH=45.02
SET DIG=82.09
DO ^DICR
End DoDot:1
+87 SET X=$PIECE($GET(DIKZ(0)),U,14)
+88 IF X'=""
XECUTE ^DD(45.02,14,1,992,1)
+89 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+90 SET X=$PIECE($GET(DIKZ(0)),U,15)
+91 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+92 SET X=$PIECE($GET(DIKZ(0)),U,15)
+93 IF X'=""
Begin DoDot:1
+94 NEW DIK,DIV,DIU,DIN
+95 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,15,1,2,1.4)
End DoDot:1
+96 SET X=$PIECE($GET(DIKZ(0)),U,15)
+97 IF X'=""
XECUTE ^DD(45.02,15,1,992,1)
+98 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+99 SET X=$PIECE($GET(DIKZ(81)),U,1)
+100 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+101 SET X=$PIECE($GET(DIKZ(81)),U,1)
+102 IF X'=""
Begin DoDot:1
+103 NEW DIK,DIV,DIU,DIN
+104 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.01,1,2,1.4)
End DoDot:1
+105 SET X=$PIECE($GET(DIKZ(81)),U,1)
+106 IF X'=""
XECUTE ^DD(45.02,81.01,1,992,1)
+107 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+108 SET X=$PIECE($GET(DIKZ(81)),U,2)
+109 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+110 SET X=$PIECE($GET(DIKZ(81)),U,2)
+111 IF X'=""
Begin DoDot:1
+112 NEW DIK,DIV,DIU,DIN
+113 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,12)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.02,1,2,1.4)
End DoDot:1
+114 SET X=$PIECE($GET(DIKZ(81)),U,2)
+115 IF X'=""
XECUTE ^DD(45.02,81.02,1,992,1)
+116 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+117 SET X=$PIECE($GET(DIKZ(81)),U,3)
+118 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+119 SET X=$PIECE($GET(DIKZ(81)),U,3)
+120 IF X'=""
Begin DoDot:1
+121 NEW DIK,DIV,DIU,DIN
+122 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,13)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.03,1,2,1.4)
End DoDot:1
+123 SET X=$PIECE($GET(DIKZ(81)),U,3)
+124 IF X'=""
XECUTE ^DD(45.02,81.03,1,992,1)
+125 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+126 SET X=$PIECE($GET(DIKZ(81)),U,4)
+127 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+128 SET X=$PIECE($GET(DIKZ(81)),U,4)
+129 IF X'=""
Begin DoDot:1
+130 NEW DIK,DIV,DIU,DIN
+131 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,14)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.04,1,2,1.4)
End DoDot:1
+132 SET X=$PIECE($GET(DIKZ(81)),U,4)
+133 IF X'=""
XECUTE ^DD(45.02,81.04,1,992,1)
+134 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+135 SET X=$PIECE($GET(DIKZ(81)),U,5)
+136 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+137 SET X=$PIECE($GET(DIKZ(81)),U,5)
+138 IF X'=""
Begin DoDot:1
+139 NEW DIK,DIV,DIU,DIN
+140 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,15)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.05,1,2,1.4)
End DoDot:1
+141 SET X=$PIECE($GET(DIKZ(81)),U,5)
+142 IF X'=""
XECUTE ^DD(45.02,81.05,1,992,1)
+143 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+144 SET X=$PIECE($GET(DIKZ(81)),U,6)
+145 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+146 SET X=$PIECE($GET(DIKZ(81)),U,6)
+147 IF X'=""
Begin DoDot:1
+148 NEW DIK,DIV,DIU,DIN
+149 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,16)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.06,1,2,1.4)
End DoDot:1
+150 SET X=$PIECE($GET(DIKZ(81)),U,6)
+151 IF X'=""
XECUTE ^DD(45.02,81.06,1,992,1)
+152 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+153 SET X=$PIECE($GET(DIKZ(81)),U,7)
+154 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+155 SET X=$PIECE($GET(DIKZ(81)),U,7)
+156 IF X'=""
Begin DoDot:1
+157 NEW DIK,DIV,DIU,DIN
+158 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,17)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.07,1,2,1.4)
End DoDot:1
+159 SET X=$PIECE($GET(DIKZ(81)),U,7)
+160 IF X'=""
XECUTE ^DD(45.02,81.07,1,992,1)
+161 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+162 SET X=$PIECE($GET(DIKZ(81)),U,8)
+163 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+164 SET X=$PIECE($GET(DIKZ(81)),U,8)
+165 IF X'=""
Begin DoDot:1
+166 NEW DIK,DIV,DIU,DIN
+167 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,18)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.08,1,2,1.4)
End DoDot:1
+168 SET X=$PIECE($GET(DIKZ(81)),U,8)
+169 IF X'=""
XECUTE ^DD(45.02,81.08,1,992,1)
+170 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+171 SET X=$PIECE($GET(DIKZ(81)),U,9)
+172 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+173 SET X=$PIECE($GET(DIKZ(81)),U,9)
+174 IF X'=""
Begin DoDot:1
+175 NEW DIK,DIV,DIU,DIN
+176 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,19)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.09,1,2,1.4)
End DoDot:1
+177 SET X=$PIECE($GET(DIKZ(81)),U,9)
+178 IF X'=""
XECUTE ^DD(45.02,81.09,1,992,1)
+179 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+180 SET X=$PIECE($GET(DIKZ(81)),U,10)
+181 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+182 SET X=$PIECE($GET(DIKZ(81)),U,10)
+183 IF X'=""
Begin DoDot:1
+184 NEW DIK,DIV,DIU,DIN
+185 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,20)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.1,1,2,1.4)
End DoDot:1
+186 SET X=$PIECE($GET(DIKZ(81)),U,10)
+187 IF X'=""
XECUTE ^DD(45.02,81.1,1,992,1)
+188 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+189 SET X=$PIECE($GET(DIKZ(81)),U,11)
+190 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+191 SET X=$PIECE($GET(DIKZ(81)),U,11)
+192 IF X'=""
Begin DoDot:1
+193 NEW DIK,DIV,DIU,DIN
+194 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,21)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.11,1,2,1.4)
End DoDot:1
+195 SET X=$PIECE($GET(DIKZ(81)),U,11)
+196 IF X'=""
XECUTE ^DD(45.02,81.11,1,992,1)
+197 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+198 SET X=$PIECE($GET(DIKZ(81)),U,12)
+199 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+200 SET X=$PIECE($GET(DIKZ(81)),U,12)
+201 IF X'=""
Begin DoDot:1
+202 NEW DIK,DIV,DIU,DIN
+203 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,22)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.12,1,2,1.4)
End DoDot:1
+204 SET X=$PIECE($GET(DIKZ(81)),U,12)
+205 IF X'=""
XECUTE ^DD(45.02,81.12,1,992,1)
+206 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+207 SET X=$PIECE($GET(DIKZ(81)),U,13)
+208 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+209 SET X=$PIECE($GET(DIKZ(81)),U,13)
+210 IF X'=""
Begin DoDot:1
+211 NEW DIK,DIV,DIU,DIN
+212 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,23)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.13,1,2,1.4)
End DoDot:1
+213 SET X=$PIECE($GET(DIKZ(81)),U,13)
+214 IF X'=""
XECUTE ^DD(45.02,81.13,1,992,1)
+215 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+216 SET X=$PIECE($GET(DIKZ(81)),U,14)
+217 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+218 SET X=$PIECE($GET(DIKZ(81)),U,14)
+219 IF X'=""
Begin DoDot:1
+220 NEW DIK,DIV,DIU,DIN
+221 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,24)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.14,1,2,1.4)
End DoDot:1
+222 SET X=$PIECE($GET(DIKZ(81)),U,14)
+223 IF X'=""
XECUTE ^DD(45.02,81.14,1,992,1)
+224 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+225 SET X=$PIECE($GET(DIKZ(81)),U,15)
+226 IF X'=""
SET ^DGPT(DA(1),"M","AC",$EXTRACT(X,1,30),DA)=""
+227 SET X=$PIECE($GET(DIKZ(81)),U,15)
+228 IF X'=""
Begin DoDot:1
+229 NEW DIK,DIV,DIU,DIN
+230 KILL DIV
SET DIV=X
SET D0=DA(1)
SET DIV(0)=D0
SET D1=DA
SET DIV(1)=D1
SET Y(1)=$SELECT($DATA(^DGPT(D0,"M",D1,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,25)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(45.02,81.15,1,2,1.4)
End DoDot:1
+231 SET X=$PIECE($GET(DIKZ(81)),U,15)
+232 IF X'=""
XECUTE ^DD(45.02,81.15,1,992,1)
CR1 SET DIXR=835
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,5)
+5 SET X(3)=$PIECE(DIKZ(0),U,6)
+6 SET X(4)=$PIECE(DIKZ(0),U,7)
+7 SET X(5)=$PIECE(DIKZ(0),U,8)
+8 SET X(6)=$PIECE(DIKZ(0),U,9)
+9 SET X(7)=$PIECE(DIKZ(0),U,11)
+10 SET X(8)=$PIECE(DIKZ(0),U,12)
+11 SET X(9)=$PIECE(DIKZ(0),U,13)
+12 SET X(10)=$PIECE(DIKZ(0),U,14)
+13 SET X(11)=$PIECE(DIKZ(0),U,15)
+14 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+15 SET X(12)=$PIECE(DIKZ(81),U,1)
+16 SET X(13)=$PIECE(DIKZ(81),U,2)
+17 SET X(14)=$PIECE(DIKZ(81),U,3)
+18 SET X(15)=$PIECE(DIKZ(81),U,4)
+19 SET X(16)=$PIECE(DIKZ(81),U,5)
+20 SET X(17)=$PIECE(DIKZ(81),U,6)
+21 SET X(18)=$PIECE(DIKZ(81),U,7)
+22 SET X(19)=$PIECE(DIKZ(81),U,8)
+23 SET X(20)=$PIECE(DIKZ(81),U,9)
+24 SET X(21)=$PIECE(DIKZ(81),U,10)
+25 SET X(22)=$PIECE(DIKZ(81),U,11)
+26 SET X(23)=$PIECE(DIKZ(81),U,12)
+27 SET X(24)=$PIECE(DIKZ(81),U,13)
+28 SET X(25)=$PIECE(DIKZ(81),U,14)
+29 SET X(26)=$PIECE(DIKZ(81),U,15)
+30 SET X=$GET(X(1))
+31 Begin DoDot:1
+32 KILL X1,X2
MERGE X1=X,X2=X
+33 DO NOTIFY^DGPTDD(.X1,.X2,.DA,45,"MOVEMENT","SET")
End DoDot:1
CR2 SET DIXR=1177
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,5)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD1")
End DoDot:1
CR3 SET DIXR=1178
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,15)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD10")
End DoDot:1
CR4 SET DIXR=1179
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,6)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD2")
End DoDot:1
CR5 SET DIXR=1180
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,7)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD3")
End DoDot:1
CR6 SET DIXR=1181
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,8)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD4")
End DoDot:1
CR7 SET DIXR=1182
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,9)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD5")
End DoDot:1
CR8 SET DIXR=1183
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,11)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD6")
End DoDot:1
CR9 SET DIXR=1184
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,12)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD7")
End DoDot:1
CR10 SET DIXR=1185
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,13)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD8")
End DoDot:1
CR11 SET DIXR=1186
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET X(2)=$PIECE(DIKZ(0),U,14)
+5 SET X=$GET(X(1))
+6 IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD9")
End DoDot:1
CR12 SET DIXR=1224
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,1)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD11")
End DoDot:1
CR13 SET DIXR=1225
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,2)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD12")
End DoDot:1
CR14 SET DIXR=1226
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,3)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD13")
End DoDot:1
CR15 SET DIXR=1227
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,4)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD14")
End DoDot:1
CR16 SET DIXR=1228
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,5)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD15")
End DoDot:1
CR17 SET DIXR=1229
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,6)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD16")
End DoDot:1
CR18 SET DIXR=1230
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,7)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD17")
End DoDot:1
CR19 SET DIXR=1231
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,8)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD18")
End DoDot:1
CR20 SET DIXR=1232
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,9)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD19")
End DoDot:1
CR21 SET DIXR=1233
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,10)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD20")
End DoDot:1
CR22 SET DIXR=1234
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,11)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD21")
End DoDot:1
CR23 SET DIXR=1235
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,12)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD22")
End DoDot:1
CR24 SET DIXR=1236
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,13)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD23")
End DoDot:1
CR25 SET DIXR=1237
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,14)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD24")
End DoDot:1
CR26 SET DIXR=1238
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"M",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,10)
+4 SET DIKZ(81)=$GET(^DGPT(DA(1),"M",DA,81))
+5 SET X(2)=$PIECE(DIKZ(81),U,15)
+6 SET X=$GET(X(1))
+7 IF $GET(X(2))]""
Begin DoDot:1
+8 KILL X1,X2
MERGE X1=X,X2=X
+9 DO SPTFMD^DGPTDDCR(.X,.DA,"M ICD25")
End DoDot:1
CR27 KILL X
+1 if '$DATA(DIKLM)
GOTO A
if $DATA(DISET)
QUIT
END GOTO ^DGPTXX12
