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