DGPTXX12.m

DGPTXX12 ; COMPILED XREF FOR FILE #45.05 ; 10/30/24

 ; 

 S DA=0

A1 ;

 I $D(DISET) K DIKLM S:DIKM1=1 DIKLM=1 G @DIKM1

0 ;

A S DA=$O(^DGPT(DA(1),"P",DA)) I DA'>0 S DA=0 G END

1 ;

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X=$P($G(DIKZ(0)),U,5)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,6)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,7)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,8)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,9)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,10)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,11)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,12)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,13)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,14)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,15)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,16)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,17)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,18)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,19)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,20)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,21)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,22)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,23)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,24)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))

 S X=$P($G(DIKZ(1)),U,1)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(1)),U,2)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(1)),U,3)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(1)),U,4)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(1)),U,5)

 I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""

CR1 S DIXR=1200

 K X

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,5)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",1)

CR2 S DIXR=1201

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,6)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",2)

CR3 S DIXR=1202

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,7)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",3)

CR4 S DIXR=1203

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 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

 . D SPTFP^DGPTDDCR(.X,.DA,"P",4)

CR5 S DIXR=1204

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",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

 . D SPTFP^DGPTDDCR(.X,.DA,"P",5)

CR6 S DIXR=1250

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,14)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",10)

CR7 S DIXR=1251

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,15)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",11)

CR8 S DIXR=1252

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,16)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",12)

CR9 S DIXR=1253

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,17)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",13)

CR10 S DIXR=1254

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,18)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",14)

CR11 S DIXR=1255

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,19)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",15)

CR12 S DIXR=1256

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,20)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",16)

CR13 S DIXR=1257

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,21)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",17)

CR14 S DIXR=1258

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,22)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",18)

CR15 S DIXR=1259

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,23)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",19)

CR16 S DIXR=1260

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,24)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",20)

CR17 S DIXR=1261

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))

 S X(2)=$P(DIKZ(1),U,1)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",21)

CR18 S DIXR=1262

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))

 S X(2)=$P(DIKZ(1),U,2)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",22)

CR19 S DIXR=1263

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))

 S X(2)=$P(DIKZ(1),U,3)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",23)

CR20 S DIXR=1264

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))

 S X(2)=$P(DIKZ(1),U,4)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",24)

CR21 S DIXR=1265

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))

 S X(2)=$P(DIKZ(1),U,5)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",25)

CR22 S DIXR=1266

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",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

 . D SPTFP^DGPTDDCR(.X,.DA,"P",6)

CR23 S DIXR=1267

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",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

 . D SPTFP^DGPTDDCR(.X,.DA,"P",7)

CR24 S DIXR=1268

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",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

 . D SPTFP^DGPTDDCR(.X,.DA,"P",8)

CR25 S DIXR=1269

 K X

 S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))

 S X(1)=$P(DIKZ(0),U,1)

 S X(2)=$P(DIKZ(0),U,13)

 S X=$G(X(1))

 I $G(X(1))]"",$G(X(2))]"" D

 . K X1,X2 M X1=X,X2=X

 . D SPTFP^DGPTDDCR(.X,.DA,"P",9)

CR26 K X

 G:'$D(DIKLM) A Q:$D(DISET)

END G ^DGPTXX13

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPTXX12   7856     printed  Feb 19, 2025@00:20:23                                                                                                                                                                                                    Page 2

DGPTXX12  ; COMPILED XREF FOR FILE #45.05 ; 10/30/24

 +1       ; 

 +2        SET DA=0

A1        ;

 +1        IF $DATA(DISET)

               KILL DIKLM

               if DIKM1=1

                   SET DIKLM=1

               GOTO @DIKM1

0         ;

A          SET DA=$ORDER(^DGPT(DA(1),"P",DA))

           IF DA'>0

               SET DA=0

               GOTO END

1         ;

 +1        SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))

 +2        SET X=$PIECE($GET(DIKZ(0)),U,5)

 +3        IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +4        SET X=$PIECE($GET(DIKZ(0)),U,6)

 +5        IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +6        SET X=$PIECE($GET(DIKZ(0)),U,7)

 +7        IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +8        SET X=$PIECE($GET(DIKZ(0)),U,8)

 +9        IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +10       SET X=$PIECE($GET(DIKZ(0)),U,9)

 +11       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +12       SET X=$PIECE($GET(DIKZ(0)),U,10)

 +13       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +14       SET X=$PIECE($GET(DIKZ(0)),U,11)

 +15       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +16       SET X=$PIECE($GET(DIKZ(0)),U,12)

 +17       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +18       SET X=$PIECE($GET(DIKZ(0)),U,13)

 +19       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +20       SET X=$PIECE($GET(DIKZ(0)),U,14)

 +21       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +22       SET X=$PIECE($GET(DIKZ(0)),U,15)

 +23       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +24       SET X=$PIECE($GET(DIKZ(0)),U,16)

 +25       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +26       SET X=$PIECE($GET(DIKZ(0)),U,17)

 +27       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +28       SET X=$PIECE($GET(DIKZ(0)),U,18)

 +29       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +30       SET X=$PIECE($GET(DIKZ(0)),U,19)

 +31       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +32       SET X=$PIECE($GET(DIKZ(0)),U,20)

 +33       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +34       SET X=$PIECE($GET(DIKZ(0)),U,21)

 +35       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +36       SET X=$PIECE($GET(DIKZ(0)),U,22)

 +37       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +38       SET X=$PIECE($GET(DIKZ(0)),U,23)

 +39       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +40       SET X=$PIECE($GET(DIKZ(0)),U,24)

 +41       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +42       SET DIKZ(1)=$GET(^DGPT(DA(1),"P",DA,1))

 +43       SET X=$PIECE($GET(DIKZ(1)),U,1)

 +44       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +45       SET X=$PIECE($GET(DIKZ(1)),U,2)

 +46       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +47       SET X=$PIECE($GET(DIKZ(1)),U,3)

 +48       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +49       SET X=$PIECE($GET(DIKZ(1)),U,4)

 +50       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

 +51       SET X=$PIECE($GET(DIKZ(1)),U,5)

 +52       IF X'=""

               SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""

CR1        SET DIXR=1200

 +1        KILL X

 +2        SET X(1)=$PIECE(DIKZ(0),U,1)

 +3        SET X(2)=$PIECE(DIKZ(0),U,5)

 +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                    DO SPTFP^DGPTDDCR(.X,.DA,"P",1)

                   End DoDot:1

CR2        SET DIXR=1201

 +1        KILL X

 +2        SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))

 +3        SET X(1)=$PIECE(DIKZ(0),U,1)

 +4        SET X(2)=$PIECE(DIKZ(0),U,6)

 +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                    DO SPTFP^DGPTDDCR(.X,.DA,"P",2)

                   End DoDot:1

CR3        SET DIXR=1202

 +1        KILL X

 +2        SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))

 +3        SET X(1)=$PIECE(DIKZ(0),U,1)

 +4        SET X(2)=$PIECE(DIKZ(0),U,7)

 +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                    DO SPTFP^DGPTDDCR(.X,.DA,"P",3)

                   End DoDot:1

CR4        SET DIXR=1203

 +1        KILL X

 +2        SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))

 +3        SET X(1)=$PIECE(DIKZ(0),U,1)

 +4        SET X(2)=$PIECE(DIKZ(0),U,8)

 +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                    DO SPTFP^DGPTDDCR(.X,.DA,"P",4)

                   End DoDot:1

CR5        SET DIXR=1204

 +1        KILL X

 +2        SET DIKZ(0)=$GET(^DGPT(DA(1),"P",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                    DO SPTFP^DGPTDDCR(.X,.DA,"P",5)

                   End DoDot:1

CR6        SET DIXR=1250

 +1        KILL X

 +2        SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))

 +3        SET X(1)=$PIECE(DIKZ(0),U,1)

 +4        SET X(2)=$PIECE(DIKZ(0),U,14)

 +5        SET X=$GET(X(1))

 +6        IF $GET(X(1))]""