Home Package List Routine Alphabetical List Global Alphabetical List FileMan Files List FileMan Sub-Files List Package Component Lists Package-Namespace Mapping
Routine: TIUEPN3

TIUEPN3.m

Go to the documentation of this file.

TIUEPN3 ; ;11/17/04

 S X=DE(8),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALOC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)

 S X=DE(8),DIC=DIE

 I +$P($G(^TIU(8925,+DA,15)),U) K ^TIU(8925,"ALOCP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)

TIUEPN3   ; ;11/17/04

 +1        SET X=DE(8)

           SET DIC=DIE

 +2        IF +$PIECE($GET(^TIU(8925,+DA,0)),U)

               IF +$PIECE($GET(^TIU(8925,+DA,13)),U)

                   IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)

                       KILL ^TIU(8925,"ALOC",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)

 +3        SET X=DE(8)

           SET DIC=DIE

 +4        IF +$PIECE($GET(^TIU(8925,+DA,15)),U)

               KILL ^TIU(8925,"ALOCP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)