TIUEDS14.m

TIUEDS14 ; ;02/28/13

 ;;

1 N X,X1,X2 S DIXR=307 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))]"",$G(X(4))]"" D

 . K ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)

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

 . S ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)=""

 Q

X1(DION) K X

 S X(1)=$G(@DIEZTMP@("V",8925,DIIENS,1212,DION),$P($G(^TIU(8925,DA,12)),U,12))

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

 S X(3)=$G(@DIEZTMP@("V",8925,DIIENS,.05,DION),$P($G(^TIU(8925,DA,0)),U,5))

 S X=$G(@DIEZTMP@("V",8925,DIIENS,1301,DION),$P($G(^TIU(8925,DA,13)),U,1))

 I $D(X)#2 S X=9999999-X

 S:$D(X)#2 X(4)=X

 S X=$G(X(1))

 Q

TIUEDS14  ; ;02/28/13

 +1       ;;

1          NEW X,X1,X2

           SET DIXR=307

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

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

                           Begin DoDot:1

 +2                            KILL ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)

                           End DoDot:1

 +3        KILL X

           MERGE X=X2

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

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

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

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

                           Begin DoDot:1

 +4                            SET ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)=""

                           End DoDot:1

 +5        QUIT 

X1(DION)   KILL X

 +1        SET X(1)=$GET(@DIEZTMP@("V",8925,DIIENS,1212,DION),$PIECE($GET(^TIU(8925,DA,12)),U,12))

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

 +3        SET X(3)=$GET(@DIEZTMP@("V",8925,DIIENS,.05,DION),$PIECE($GET(^TIU(8925,DA,0)),U,5))

 +4        SET X=$GET(@DIEZTMP@("V",8925,DIIENS,1301,DION),$PIECE($GET(^TIU(8925,DA,13)),U,1))

 +5        IF $DATA(X)#2

               SET X=9999999-X

 +6        IF $DATA(X)#2

               SET X(4)=X

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

 +8        QUIT