- 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
