TIUEPN9 ; ;11/17/04
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)
TIUEPN9 ; ;11/17/04
+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)
