- 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
