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

TIUEPN14.m

Go to the documentation of this file.

TIUEPN14 ; ;11/17/04

 S X=DG(DQ),DIC=DIE

 S ^TIU(8925,"CS",$E(X,1,30),DA)=""

 S X=DG(DQ),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) S ^TIU(8925,"ASUP",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)=""

 S X=DG(DQ),DIC=DIE

 D SACLEC^TIUDD0(1208,X)

TIUEPN14  ; ;11/17/04

 +1        SET X=DG(DQ)

           SET DIC=DIE

 +2        SET ^TIU(8925,"CS",$EXTRACT(X,1,30),DA)=""

 +3        SET X=DG(DQ)

           SET DIC=DIE

 +4        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)

                       SET ^TIU(8925,"ASUP",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)=""

 +5        SET X=DG(DQ)

           SET DIC=DIE

 +6        DO SACLEC^TIUDD0(1208,X)