DGPTXX3 ; COMPILED XREF FOR FILE #45.01 ; 10/15/12
;
S DA(1)=DA S DA=0
A1 ;
I $D(DIKILL) K DIKLM S:DIKM1=1 DIKLM=1 G @DIKM1
0 ;
A S DA=$O(^DGPT(DA(1),"S",DA)) I DA'>0 S DA=0 G END
1 ;
S DIKZ(0)=$G(^DGPT(DA(1),"S",DA,0))
S X=$P($G(DIKZ(0)),U,8)
I X'="" K ^DGPT(DA(1),"S","AO",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,9)
I X'="" K ^DGPT(DA(1),"S","AO",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,10)
I X'="" K ^DGPT(DA(1),"S","AO",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,11)
I X'="" K ^DGPT(DA(1),"S","AO",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,12)
I X'="" K ^DGPT(DA(1),"S","AO",$E(X,1,30),DA)
CR1 S DIXR=361
K X
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,8)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. D KDGPT0^DGPTDDCR(.X,.DA,"S",1)
CR2 S DIXR=362
K X
S DIKZ(0)=$G(^DGPT(DA(1),"S",DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,9)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. D KDGPT0^DGPTDDCR(.X,.DA,"S",2)
CR3 S DIXR=363
K X
S DIKZ(0)=$G(^DGPT(DA(1),"S",DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,10)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. D KDGPT0^DGPTDDCR(.X,.DA,"S",3)
CR4 S DIXR=364
K X
S DIKZ(0)=$G(^DGPT(DA(1),"S",DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,11)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. D KDGPT0^DGPTDDCR(.X,.DA,"S",4)
CR5 S DIXR=365
K X
S DIKZ(0)=$G(^DGPT(DA(1),"S",DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,12)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. D KDGPT0^DGPTDDCR(.X,.DA,"S",5)
CR6 K X
G:'$D(DIKLM) A Q:$D(DIKILL)
END G ^DGPTXX4
DGPTXX3 ; COMPILED XREF FOR FILE #45.01 ; 10/15/12
+1 ;
+2 SET DA(1)=DA
SET DA=0
A1 ;
+1 IF $DATA(DIKILL)
KILL DIKLM
IF DIKM1=1
SET DIKLM=1
GOTO @DIKM1
0 ;
A SET DA=$ORDER(^DGPT(DA(1),"S",DA))
IF DA'>0
SET DA=0
GOTO END
1 ;
+1 SET DIKZ(0)=$GET(^DGPT(DA(1),"S",DA,0))
+2 SET X=$PIECE($GET(DIKZ(0)),U,8)
+3 IF X'=""
KILL ^DGPT(DA(1),"S","AO",$EXTRACT(X,1,30),DA)
+4 SET X=$PIECE($GET(DIKZ(0)),U,9)
+5 IF X'=""
KILL ^DGPT(DA(1),"S","AO",$EXTRACT(X,1,30),DA)
+6 SET X=$PIECE($GET(DIKZ(0)),U,10)
+7 IF X'=""
KILL ^DGPT(DA(1),"S","AO",$EXTRACT(X,1,30),DA)
+8 SET X=$PIECE($GET(DIKZ(0)),U,11)
+9 IF X'=""
KILL ^DGPT(DA(1),"S","AO",$EXTRACT(X,1,30),DA)
+10 SET X=$PIECE($GET(DIKZ(0)),U,12)
+11 IF X'=""
KILL ^DGPT(DA(1),"S","AO",$EXTRACT(X,1,30),DA)
CR1 SET DIXR=361
+1 KILL X
+2 SET X(1)=$PIECE(DIKZ(0),U,1)
+3 SET X(2)=$PIECE(DIKZ(0),U,8)
+4 SET X=$GET(X(1))
+5 IF $GET(X(1))]""
IF $GET(X(2))]""
Begin DoDot:1
+6 KILL X1,X2
MERGE X1=X,X2=X
+7 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+8 DO KDGPT0^DGPTDDCR(.X,.DA,"S",1)
End DoDot:1
CR2 SET DIXR=362
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"S",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,9)
+5 SET X=$GET(X(1))
+6 IF $GET(X(1))]""
IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+9 DO KDGPT0^DGPTDDCR(.X,.DA,"S",2)
End DoDot:1
CR3 SET DIXR=363
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"S",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,10)
+5 SET X=$GET(X(1))
+6 IF $GET(X(1))]""
IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+9 DO KDGPT0^DGPTDDCR(.X,.DA,"S",3)
End DoDot:1
CR4 SET DIXR=364
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"S",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,11)
+5 SET X=$GET(X(1))
+6 IF $GET(X(1))]""
IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+9 DO KDGPT0^DGPTDDCR(.X,.DA,"S",4)
End DoDot:1
CR5 SET DIXR=365
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA(1),"S",DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,12)
+5 SET X=$GET(X(1))
+6 IF $GET(X(1))]""
IF $GET(X(2))]""
Begin DoDot:1
+7 KILL X1,X2
MERGE X1=X,X2=X
+8 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+9 DO KDGPT0^DGPTDDCR(.X,.DA,"S",5)
End DoDot:1
CR6 KILL X
+1 IF '$DATA(DIKLM)
GOTO A
IF $DATA(DIKILL)
QUIT
END GOTO ^DGPTXX4
