DGPMX31.m

DGPMX31 ; ;10/30/24

 ;;

1 N X,X1,X2 S DIXR=1515 D X1(U) K X2 M X2=X D X1("F") K X1 M X1=X

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

 . K ^DGPM("AC",X(1),X(2),X(3),DA)

 K X M X=X2 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"" D

 . S ^DGPM("AC",X(1),X(2),X(3),DA)=""

 Q

X1(DION) K X

 S X(1)=$G(@DIEZTMP@("V",405,DIIENS,.01,DION),$P($G(^DGPM(DA,0)),U,1))

 S X(2)=$G(@DIEZTMP@("V",405,DIIENS,.02,DION),$P($G(^DGPM(DA,0)),U,2))

 S X(3)=$G(@DIEZTMP@("V",405,DIIENS,.03,DION),$P($G(^DGPM(DA,0)),U,3))

 S X=$G(X(1))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPMX31   516     printed  Dec 13, 2024@02:50:37                                                                                                                                                                                                      Page 2

DGPMX31   ; ;10/30/24

 +1       ;;

1          NEW X,X1,X2

           SET DIXR=1515

           DO X1(U)

           KILL X2

           MERGE X2=X

           DO X1("F")

           KILL X1

           MERGE X1=X

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

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

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

                       Begin DoDot:1

 +2                        KILL ^DGPM("AC",X(1),X(2),X(3),DA)

                       End DoDot:1

 +3        KILL X

           MERGE X=X2

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

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

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

                       Begin DoDot:1

 +4                        SET ^DGPM("AC",X(1),X(2),X(3),DA)=""

                       End DoDot:1

 +5        QUIT 

X1(DION)   KILL X

 +1        SET X(1)=$GET(@DIEZTMP@("V",405,DIIENS,.01,DION),$PIECE($GET(^DGPM(DA,0)),U,1))

 +2        SET X(2)=$GET(@DIEZTMP@("V",405,DIIENS,.02,DION),$PIECE($GET(^DGPM(DA,0)),U,2))

 +3        SET X(3)=$GET(@DIEZTMP@("V",405,DIIENS,.03,DION),$PIECE($GET(^DGPM(DA,0)),U,3))

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

 +5        QUIT