DGPTXX2.m

DGPTXX2 ; COMPILED XREF FOR FILE #45 ; 10/30/24

 ; 

 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 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

 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""

 . D KPTFDD^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

 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""

 . D KPTFDD^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

 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""

 . D KPTFDD^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))

 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 SD21")

CR25 S DIXR=1247

 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,13)

 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 SD22")

CR26 S DIXR=1248

 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,14)

 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 SD23")

CR27 S DIXR=1249

 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,15)

 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 SD24")

CR28 S DIXR=1691

 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("401P")=$G(^DGPT(DA,"401P"))

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

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

 S X(5)=$P(DIKZ("401P"),U,3)

 S X(6)=$P(DIKZ("401P"),U,4)

 S X(7)=$P(DIKZ("401P"),U,5)

 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))=""

 . D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","KILL")

CR29 K X

END G ^DGPTXX3

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPTXX2   3695     printed  Nov 22, 2024@18:04:23                                                                                                                                                                                                     Page 2

DGPTXX2   ; COMPILED XREF FOR FILE #45 ; 10/30/24

 +1       ; 

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

               IF $GET(X(2))]""

                   IF $GET(X(3))]""

                       IF $GET(X(4))]""

                           Begin DoDot:1

 +3                            KILL X1,X2

                               MERGE X1=X,X2=X

 +4                            if $DATA(DIKIL)

                                   SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""

 +5                            DO KPTFDD^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                           if $DATA(DIKIL)

                                   SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""

 +14                           DO KPTFDD^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                           if $DATA(DIKIL)

                                   SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""

 +14                           DO KPTFDD^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                           if $DATA(DIKIL)

                                   SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""

 +14                           DO KPTFDD^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))

 +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 SD21")

                           End DoDot:1

CR25       SET DIXR=1247

 +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,13)

 +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 SD22")

                           End DoDot:1

CR26       SET DIXR=1248

 +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,14)

 +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 SD23")

                           End DoDot:1

CR27       SET DIXR=1249

 +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,15)

 +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 SD24")

                           End DoDot:1

CR28       SET DIXR=1691

 +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("401P")=$GET(^DGPT(DA,"401P"))

 +6        SET X(3)=$PIECE(DIKZ("401P"),U,1)

 +7        SET X(4)=$PIECE(DIKZ("401P"),U,2)

 +8        SET X(5)=$PIECE(DIKZ("401P"),U,3)

 +9        SET X(6)=$PIECE(DIKZ("401P"),U,4)

 +10       SET X(7)=$PIECE(DIKZ("401P"),U,5)

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

 +12       Begin DoDot:1

 +13           KILL X1,X2

               MERGE X1=X,X2=X

 +14           if $DATA(DIKIL)

                   SET (X2,X2(1),X2(2),X2(3),X2(4),X2(5),X2(6),X2(7))=""

 +15           DO NOTIFYP^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","KILL")

           End DoDot:1

CR29       KILL X

END        GOTO ^DGPTXX3