- DGPTXX8 ; COMPILED XREF FOR FILE #45 ; 10/30/24
- ;
- S DIKZK=1
- S DIKZ(0)=$G(^DGPT(DA,0))
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" S ^DGPT("B",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" S L=+^DGPT(DA,0) I L>0 S ^DGPT("AAD",L,X,DA)=""
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" S ^DGPT("AF",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" S L=$S($D(^DGPT(DA,70)):+^(70),1:0) I L'?7N.E S ^DGPT("AADA",X,DA)=""
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" I $P(^DGPT(DA,0),U,4),$P(^(0),U) S ^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) S ^DGPT("AFEE",$P(^DGPT(DA,0),U),$P(^DGPT(DA,0),U,2),DA)=""
- S X=$P($G(DIKZ(0)),U,6)
- I X'="" S ^DGPT("AS",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,10)
- I X'="" S ^DGPT("AMT",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,12)
- I X'="" S ^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=2 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 %>0 S %C=$S($D(^DPT(%,.3)):^(.3),1:"")_"^^^^^^^^^^",^(.3)=$P(%C,U,1,9)_U_X_U_$P(%C,U,11,99),^DPT("ACB",X,%)="" K ^DPT("ACB",+$P(%C,U,10),%),%,%C
- S DIKZ("401P")=$G(^DGPT(DA,"401P"))
- S X=$P($G(DIKZ("401P")),U,1)
- I X'="" S ^DGPT(DA,"AP",X)=""
- S X=$P($G(DIKZ("401P")),U,2)
- I X'="" S ^DGPT(DA,"AP",X)=""
- S X=$P($G(DIKZ("401P")),U,3)
- I X'="" S ^DGPT(DA,"AP",X)=""
- S X=$P($G(DIKZ("401P")),U,4)
- I X'="" S ^DGPT(DA,"AP",X)=""
- S X=$P($G(DIKZ("401P")),U,5)
- I X'="" S ^DGPT(DA,"AP",X)=""
- S DIKZ(70)=$G(^DGPT(DA,70))
- S X=$P($G(DIKZ(70)),U,1)
- I X'="" S ^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)=X 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 K ^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)=X 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- S DIKZ(71)=$G(^DGPT(DA,71))
- S X=$P($G(DIKZ(71)),U,1)
- I X'="" X ^DD(45,79.241,1,1,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- 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,1)
- CR1 S DIXR=401
- 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,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
- . D SPTFDD^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
- . D NOTIFY^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","SET")
- 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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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
- . D SPTFDD^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))
- I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFDD^DGPTDDCR(.X,.DA,"D SD17")
- CR21 S DIXR=1243
- 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,9)
- 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
- . D SPTFDD^DGPTDDCR(.X,.DA,"D SD18")
- CR22 S DIXR=1244
- 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,10)
- 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
- . D SPTFDD^DGPTDDCR(.X,.DA,"D SD19")
- CR23 S DIXR=1245
- 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,11)
- 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
- . D SPTFDD^DGPTDDCR(.X,.DA,"D SD20")
- CR24 S DIXR=1246
- 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,12)
- S DIKZ(70)=$G(^DGPT(DA,70))
- S X(5)=$P(DIKZ(70),U,1)
- S X=$G(X(1))
- END G ^DGPTXX9
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTXX8 19943 printed Feb 19, 2025@00:20:31 Page 2
- DGPTXX8 ; COMPILED XREF FOR FILE #45 ; 10/30/24
- +1 ;
- +2 SET DIKZK=1
- +3 SET DIKZ(0)=$GET(^DGPT(DA,0))
- +4 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +5 IF X'=""
- SET ^DGPT("B",$EXTRACT(X,1,30),DA)=""
- +6 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +7 IF X'=""
- SET L=+^DGPT(DA,0)
- IF L>0
- SET ^DGPT("AAD",L,X,DA)=""
- +8 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +9 IF X'=""
- SET ^DGPT("AF",$EXTRACT(X,1,30),DA)=""
- +10 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +11 IF X'=""
- SET L=$SELECT($DATA(^DGPT(DA,70)):+^(70),1:0)
- IF L'?7N.E
- SET ^DGPT("AADA",X,DA)=""
- +12 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +13 IF X'=""
- IF $PIECE(^DGPT(DA,0),U,4)
- IF $PIECE(^(0),U)
- SET ^DGPT("AFEE",$PIECE(^DGPT(DA,0),U),$EXTRACT(X,1,30),DA)=""
- +14 SET X=$PIECE($GET(DIKZ(0)),U,4)
- +15 IF X'=""
- IF $PIECE(^DGPT(DA,0),U)
- IF $PIECE(^(0),U,2)
- SET ^DGPT("AFEE",$PIECE(^DGPT(DA,0),U),$PIECE(^DGPT(DA,0),U,2),DA)=""
- +16 SET X=$PIECE($GET(DIKZ(0)),U,6)
- +17 IF X'=""
- SET ^DGPT("AS",$EXTRACT(X,1,30),DA)=""
- +18 SET X=$PIECE($GET(DIKZ(0)),U,10)
- +19 IF X'=""
- SET ^DGPT("AMT",$EXTRACT(X,1,30),DA)=""
- +20 SET X=$PIECE($GET(DIKZ(0)),U,12)
- +21 IF X'=""
- SET ^DGPT("ACENSUS",$EXTRACT(X,1,30),DA)=""
- +22 SET X=$PIECE($GET(DIKZ(0)),U,13)
- +23 IF X'=""
- Begin DoDot:1
- +24 NEW DIK,DIV,DIU,DIN
- +25 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=2
- 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
- +26 SET DIKZ(101)=$GET(^DGPT(DA,101))
- +27 SET X=$PIECE($GET(DIKZ(101)),U,4)
+28 IF X'=""
SET %=+^DGPT(DA,0)
IF %>0
SET %C=$SELECT($DATA(^DPT(%,.3)):^(.3),1:"")_"^^^^^^^^^^"
SET ^(.3)=$PIECE(%C,U,1,9)_U_X_U_$PIECE(%C,U,11,99)
SET ^DPT("ACB",X,%)=""
KILL ^DPT("ACB",+$PIECE(%C,U,10),%),%,%C
+29 SET DIKZ("401P")=$GET(^DGPT(DA,"401P"))
+30 SET X=$PIECE($GET(DIKZ("401P")),U,1)
+31 IF X'=""
SET ^DGPT(DA,"AP",X)=""
+32 SET X=$PIECE($GET(DIKZ("401P")),U,2)
+33 IF X'=""
SET ^DGPT(DA,"AP",X)=""
+34 SET X=$PIECE($GET(DIKZ("401P")),U,3)
+35 IF X'=""
SET ^DGPT(DA,"AP",X)=""
+36 SET X=$PIECE($GET(DIKZ("401P")),U,4)
+37 IF X'=""
SET ^DGPT(DA,"AP",X)=""
+38 SET X=$PIECE($GET(DIKZ("401P")),U,5)
+39 IF X'=""
SET ^DGPT(DA,"AP",X)=""
+40 SET DIKZ(70)=$GET(^DGPT(DA,70))
+41 SET X=$PIECE($GET(DIKZ(70)),U,1)
+42 IF X'=""
SET ^DGPT("ADS",$EXTRACT(X,1,30),DA)=""
+43 SET X=$PIECE($GET(DIKZ(70)),U,1)
+44 IF X'=""
NEW DGFDA,DGMSG
SET DGFDA(45.02,"1,"_$$IENS^DILF(DA),10)=X
DO FILE^DIE("","DGFDA","DGMSG")
KILL DGFDA,DGMSG
+45 SET X=$PIECE($GET(DIKZ(70)),U,1)
+46 IF X'=""
SET L=$PIECE(^DGPT(DA,0),"^",2)
IF L?7N.E
KILL ^DGPT("AADA",L,DA)
+47 SET X=$PIECE($GET(DIKZ(70)),U,2)
+48 IF X'=""
IF $DATA(^DGPT(DA,"M",1,0))
NEW DGFDA,DGMSG
SET DGFDA(45.02,"1,"_$$IENS^DILF(DA),2)=X
DO FILE^DIE("","DGFDA","DGMSG")
KILL DGFDA,DGMSG
+49 SET X=$PIECE($GET(DIKZ(70)),U,10)
+50 IF X'=""
Begin DoDot:1
+51 NEW DIK,DIV,DIU,DIN
+52 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
+53 SET X=$PIECE($GET(DIKZ(70)),U,10)
+54 IF X'=""
XECUTE ^DD(45,79,1,992,1)
+55 SET DIKZ(70)=$GET(^DGPT(DA,70))
+56 SET X=$PIECE($GET(DIKZ(70)),U,16)
+57 IF X'=""
Begin DoDot:1
+58 NEW DIK,DIV,DIU,DIN
+59 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
+60 SET X=$PIECE($GET(DIKZ(70)),U,16)
+61 IF X'=""
XECUTE ^DD(45,79.16,1,992,1)
+62 SET DIKZ(70)=$GET(^DGPT(DA,70))
+63 SET X=$PIECE($GET(DIKZ(70)),U,17)
+64 IF X'=""
Begin DoDot:1
+65 NEW DIK,DIV,DIU,DIN
+66 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
+67 SET X=$PIECE($GET(DIKZ(70)),U,17)
+68 IF X'=""
XECUTE ^DD(45,79.17,1,992,1)
+69 SET DIKZ(70)=$GET(^DGPT(DA,70))
+70 SET X=$PIECE($GET(DIKZ(70)),U,18)
+71 IF X'=""
Begin DoDot:1
+72 NEW DIK,DIV,DIU,DIN
+73 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
+74 SET X=$PIECE($GET(DIKZ(70)),U,18)
+75 IF X'=""
XECUTE ^DD(45,79.18,1,992,1)
+76 SET DIKZ(70)=$GET(^DGPT(DA,70))
+77 SET X=$PIECE($GET(DIKZ(70)),U,19)
+78 IF X'=""
Begin DoDot:1
+79 NEW DIK,DIV,DIU,DIN
+80 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
+81 SET X=$PIECE($GET(DIKZ(70)),U,19)
+82 IF X'=""
XECUTE ^DD(45,79.19,1,992,1)
+83 SET DIKZ(70)=$GET(^DGPT(DA,70))
+84 SET X=$PIECE($GET(DIKZ(70)),U,20)
+85 IF X'=""
Begin DoDot:1
+86 NEW DIK,DIV,DIU,DIN
+87 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
+88 SET X=$PIECE($GET(DIKZ(70)),U,20)
+89 IF X'=""
XECUTE ^DD(45,79.201,1,992,1)
+90 SET DIKZ(70)=$GET(^DGPT(DA,70))
+91 SET X=$PIECE($GET(DIKZ(70)),U,21)
+92 IF X'=""
Begin DoDot:1
+93 NEW DIK,DIV,DIU,DIN
+94 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
+95 SET X=$PIECE($GET(DIKZ(70)),U,21)
+96 IF X'=""
XECUTE ^DD(45,79.21,1,992,1)
+97 SET DIKZ(70)=$GET(^DGPT(DA,70))
+98 SET X=$PIECE($GET(DIKZ(70)),U,22)
+99 IF X'=""
Begin DoDot:1
+100 NEW DIK,DIV,DIU,DIN
+101 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
+102 SET X=$PIECE($GET(DIKZ(70)),U,22)
+103 IF X'=""
XECUTE ^DD(45,79.22,1,992,1)
+104 SET DIKZ(70)=$GET(^DGPT(DA,70))
+105 SET X=$PIECE($GET(DIKZ(70)),U,23)
+106 IF X'=""
Begin DoDot:1
+107 NEW DIK,DIV,DIU,DIN
+108 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
+109 SET X=$PIECE($GET(DIKZ(70)),U,23)
+110 IF X'=""
XECUTE ^DD(45,79.23,1,992,1)
+111 SET DIKZ(70)=$GET(^DGPT(DA,70))
+112 SET X=$PIECE($GET(DIKZ(70)),U,24)
+113 IF X'=""
Begin DoDot:1
+114 NEW DIK,DIV,DIU,DIN
+115 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
+116 SET X=$PIECE($GET(DIKZ(70)),U,24)
+117 IF X'=""
XECUTE ^DD(45,79.24,1,992,1)
+118 SET DIKZ(71)=$GET(^DGPT(DA,71))
+119 SET X=$PIECE($GET(DIKZ(71)),U,1)
+120 IF X'=""
XECUTE ^DD(45,79.241,1,1,1)
+121 SET X=$PIECE($GET(DIKZ(71)),U,1)
+122 IF X'=""
Begin DoDot:1
+123 NEW DIK,DIV,DIU,DIN
+124 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
+125 SET DIKZ(71)=$GET(^DGPT(DA,71))
+126 SET X=$PIECE($GET(DIKZ(71)),U,2)
+127 IF X'=""
XECUTE ^DD(45,79.242,1,1,1)
+128 SET X=$PIECE($GET(DIKZ(71)),U,2)
+129 IF X'=""
Begin DoDot:1
+130 NEW DIK,DIV,DIU,DIN
+131 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
+132 SET DIKZ(71)=$GET(^DGPT(DA,71))
+133 SET X=$PIECE($GET(DIKZ(71)),U,3)
+134 IF X'=""
XECUTE ^DD(45,79.243,1,1,1)
+135 SET X=$PIECE($GET(DIKZ(71)),U,3)
+136 IF X'=""
Begin DoDot:1
+137 NEW DIK,DIV,DIU,DIN
+138 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
+139 SET DIKZ(71)=$GET(^DGPT(DA,71))
+140 SET X=$PIECE($GET(DIKZ(71)),U,4)
+141 IF X'=""
XECUTE ^DD(45,79.244,1,1,1)
+142 SET X=$PIECE($GET(DIKZ(71)),U,4)
+143 IF X'=""
Begin DoDot:1
+144 NEW DIK,DIV,DIU,DIN
+145 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
+146 SET DIKZ(71)=$GET(^DGPT(DA,71))
+147 SET X=$PIECE($GET(DIKZ(71)),U,5)
+148 IF X'=""
XECUTE ^DD(45,79.245,1,1,1)
+149 SET X=$PIECE($GET(DIKZ(71)),U,5)
+150 IF X'=""
Begin DoDot:1
+151 NEW DIK,DIV,DIU,DIN
+152 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
+153 SET DIKZ(71)=$GET(^DGPT(DA,71))
+154 SET X=$PIECE($GET(DIKZ(71)),U,6)
+155 IF X'=""
XECUTE ^DD(45,79.246,1,1,1)
+156 SET X=$PIECE($GET(DIKZ(71)),U,6)
+157 IF X'=""
Begin DoDot:1
+158 NEW DIK,DIV,DIU,DIN
+159 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
+160 SET DIKZ(71)=$GET(^DGPT(DA,71))
+161 SET X=$PIECE($GET(DIKZ(71)),U,7)
+162 IF X'=""
XECUTE ^DD(45,79.247,1,1,1)
+163 SET X=$PIECE($GET(DIKZ(71)),U,7)
+164 IF X'=""
Begin DoDot:1
+165 NEW DIK,DIV,DIU,DIN
+166 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
+167 SET DIKZ(71)=$GET(^DGPT(DA,71))
+168 SET X=$PIECE($GET(DIKZ(71)),U,8)
+169 IF X'=""
XECUTE ^DD(45,79.248,1,1,1)
+170 SET X=$PIECE($GET(DIKZ(71)),U,8)
+171 IF X'=""
Begin DoDot:1
+172 NEW DIK,DIV,DIU,DIN
+173 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
+174 SET DIKZ(71)=$GET(^DGPT(DA,71))
+175 SET X=$PIECE($GET(DIKZ(71)),U,9)
+176 IF X'=""
XECUTE ^DD(45,79.249,1,1,1)
+177 SET X=$PIECE($GET(DIKZ(71)),U,9)
+178 IF X'=""
Begin DoDot:1
+179 NEW DIK,DIV,DIU,DIN
+180 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
+181 SET DIKZ(71)=$GET(^DGPT(DA,71))
+182 SET X=$PIECE($GET(DIKZ(71)),U,10)
+183 IF X'=""
XECUTE ^DD(45,79.2491,1,1,1)
+184 SET X=$PIECE($GET(DIKZ(71)),U,10)
+185 IF X'=""
Begin DoDot:1
+186 NEW DIK,DIV,DIU,DIN
+187 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
+188 SET DIKZ(71)=$GET(^DGPT(DA,71))
+189 SET X=$PIECE($GET(DIKZ(71)),U,11)
+190 IF X'=""
XECUTE ^DD(45,79.24911,1,1,1)
+191 SET X=$PIECE($GET(DIKZ(71)),U,11)
+192 IF X'=""
Begin DoDot:1
+193 NEW DIK,DIV,DIU,DIN
+194 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
+195 SET DIKZ(71)=$GET(^DGPT(DA,71))
+196 SET X=$PIECE($GET(DIKZ(71)),U,12)
+197 IF X'=""
XECUTE ^DD(45,79.24912,1,1,1)
+198 SET X=$PIECE($GET(DIKZ(71)),U,12)
+199 IF X'=""
Begin DoDot:1
+200 NEW DIK,DIV,DIU,DIN
+201 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
+202 SET DIKZ(71)=$GET(^DGPT(DA,71))
+203 SET X=$PIECE($GET(DIKZ(71)),U,13)
+204 IF X'=""
XECUTE ^DD(45,79.24913,1,1,1)
+205 SET X=$PIECE($GET(DIKZ(71)),U,13)
+206 IF X'=""
Begin DoDot:1
+207 NEW DIK,DIV,DIU,DIN
+208 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
+209 SET DIKZ(71)=$GET(^DGPT(DA,71))
+210 SET X=$PIECE($GET(DIKZ(71)),U,14)
+211 IF X'=""
XECUTE ^DD(45,79.24914,1,1,1)
+212 SET X=$PIECE($GET(DIKZ(71)),U,14)
+213 IF X'=""
Begin DoDot:1
+214 NEW DIK,DIV,DIU,DIN
+215 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
+216 SET DIKZ(71)=$GET(^DGPT(DA,71))
+217 SET X=$PIECE($GET(DIKZ(71)),U,15)
+218 IF X'=""
XECUTE ^DD(45,79.24915,1,1,1)
+219 SET X=$PIECE($GET(DIKZ(71)),U,15)
+220 IF X'=""
Begin DoDot:1
+221 NEW DIK,DIV,DIU,DIN
+222 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
+223 SET DIKZ(70)=$GET(^DGPT(DA,70))
+224 SET X=$PIECE($GET(DIKZ(70)),U,11)
+225 IF X'=""
XECUTE ^DD(45,80,1,992,1)
CR1 SET DIXR=401
+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,11)
+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 DO SPTFDD^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 DO NOTIFY^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","SET")
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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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 DO SPTFDD^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))
+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 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD17")
End DoDot:1
CR21 SET DIXR=1243
+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,9)
+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 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD18")
End DoDot:1
CR22 SET DIXR=1244
+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,10)
+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 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD19")
End DoDot:1
CR23 SET DIXR=1245
+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,11)
+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 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD20")
End DoDot:1
CR24 SET DIXR=1246
+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,12)
+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 ^DGPTXX9
