TIUEPN9.m

TIUEPN9 ; ;04/07/16

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"AAU",+$P(^TIU(8925,+DA,12),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,8),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ASUP",+$P(^TIU(8925,+DA,12),U,8),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ATS",+$P(^TIU(8925,+DA,14),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ATC",+$P(^TIU(8925,+DA,13),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ALL","ANY",+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),$L($P($G(^TIU(8925,+DA,17)),U)) D ASUBS^TIUDD($P($G(^TIU(8925,+DA,17)),U),+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ASVC",+$P(^TIU(8925,+DA,14),U,4),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$O(^TIU(8925.9,"B",+DA,0)) D APRBS^TIUDD(+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,3),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P($G(^TIU(8925,+DA,0)),U,4),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ADCPT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U,4),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA)=""

 S X=DG(DQ),DIC=DIE

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

 S X=DG(DQ),DIC=DIE

 I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) S ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)=""

 S X=DG(DQ),DIC=DIE

 I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) S ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)=""

 S X=DG(DQ),DIC=DIE

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

 S X=DG(DQ),DIC=DIE

 D SACLPT^TIUDD0(1301,X)

 S X=DG(DQ),DIC=DIE

 D SACLAU^TIUDD0(1301,X),SACLAU1^TIUDD0(1301,X)

 S X=DG(DQ),DIC=DIE

 D SACLEC^TIUDD0(1301,X)

 S X=DG(DQ),DIC=DIE

 D SACLSB^TIUDD0(1301,X)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIUEPN9   3288     printed  Apr 23, 2025@18:55:01                                                                                                                                                                                                     Page 2

TIUEPN9   ; ;04/07/16

 +1        SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       SET ^TIU(8925,"AAU",+$PIECE(^TIU(8925,+DA,12),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 +3        SET X=DG(DQ)

           SET DIC=DIE

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

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

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

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

 +5        SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       SET ^TIU(8925,"APT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 +7        SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       SET ^TIU(8925,"ATS",+$PIECE(^TIU(8925,+DA,14),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 +9        SET X=DG(DQ)

           SET DIC=DIE

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

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

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

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

 +11       SET X=DG(DQ)

           SET DIC=DIE

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

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

                   SET ^TIU(8925,"ALL","ANY",+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 +13       SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       DO ASUBS^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 +15       SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       SET ^TIU(8925,"ASVC",+$PIECE(^TIU(8925,+DA,14),U,4),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 +17       SET X=DG(DQ)

           SET DIC=DIE

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

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

                   IF +$ORDER(^TIU(8925.9,"B",+DA,0))

                       DO APRBS^TIUDD(+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)

 +19       SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       SET ^TIU(8925,"AVSIT",+$PIECE(^TIU(8925,+DA,0),U,3),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),DA)=""

 +21       SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       SET ^TIU(8925,"ADCPT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U,4),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),DA)=""

 +23       SET X=DG(DQ)

           SET DIC=DIE

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

 +25       SET X=DG(DQ)

           SET DIC=DIE

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

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

                   SET ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$PIECE(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)=""

 +27       SET X=DG(DQ)

           SET DIC=DIE

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

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

                   SET ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)=""

 +29       SET X=DG(DQ)

           SET DIC=DIE

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

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

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

                       SET ^TIU(8925,"ALOC",+$PIECE(^TIU(8925,+DA,12),U,5),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""

 +31       SET X=DG(DQ)

           SET DIC=DIE

 +32       DO SACLPT^TIUDD0(1301,X)

 +33       SET X=DG(DQ)

           SET DIC=DIE

 +34       DO SACLAU^TIUDD0(1301,X)

           DO SACLAU1^TIUDD0(1301,X)

 +35       SET X=DG(DQ)

           SET DIC=DIE

 +36       DO SACLEC^TIUDD0(1301,X)

 +37       SET X=DG(DQ)

           SET DIC=DIE

 +38       DO SACLSB^TIUDD0(1301,X)