- TIUEPN8 ; ;04/07/16
- S X=DE(23),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) K ^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=DE(23),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) K ^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=DE(23),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) K ^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=DE(23),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) K ^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=DE(23),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) K ^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=DE(23),DIC=DIE
- I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALL","ANY",+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
- S X=DE(23),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 ASUBK^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=DE(23),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) K ^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=DE(23),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 APRBK^TIUDD(+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
- S X=DE(23),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) K ^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=DE(23),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) K ^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=DE(23),DIC=DIE
- K ^TIU(8925,"D",$E(X,1,30),DA)
- S X=DE(23),DIC=DIE
- I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)
- S X=DE(23),DIC=DIE
- I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)
- S X=DE(23),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) K ^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=DE(23),DIC=DIE
- D KACLPT^TIUDD01(1301,X)
- S X=DE(23),DIC=DIE
- D KACLAU^TIUDD01(1301,X),KACLAU1^TIUDD01(1301,X)
- S X=DE(23),DIC=DIE
- D KACLEC^TIUDD01(1301,X)
- S X=DE(23),DIC=DIE
- D KACLSB^TIUDD01(1301,X)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEPN8 3254 printed Mar 13, 2025@21:45:24 Page 2
- TIUEPN8 ; ;04/07/16
- +1 SET X=DE(23)
- 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)
- KILL ^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=DE(23)
- 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)
- KILL ^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=DE(23)
- 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)
- KILL ^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=DE(23)
- 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)
- KILL ^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=DE(23)
- 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)
- KILL ^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=DE(23)
- SET DIC=DIE
- +12 IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
- IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
- KILL ^TIU(8925,"ALL","ANY",+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
- +13 SET X=DE(23)
- 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 ASUBK^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=DE(23)
- 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)
- KILL ^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=DE(23)
- 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 APRBK^TIUDD(+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
- +19 SET X=DE(23)
- 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)
- KILL ^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=DE(23)
- 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)
- KILL ^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=DE(23)
- SET DIC=DIE
- +24 KILL ^TIU(8925,"D",$EXTRACT(X,1,30),DA)
- +25 SET X=DE(23)
- SET DIC=DIE
- +26 IF +$PIECE(^TIU(8925,+DA,0),U)
- IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
- KILL ^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=DE(23)
- SET DIC=DIE
- +28 IF +$PIECE(^TIU(8925,+DA,0),U)
- IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
- KILL ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)
- +29 SET X=DE(23)
- 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)
- KILL ^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=DE(23)
- SET DIC=DIE
- +32 DO KACLPT^TIUDD01(1301,X)
- +33 SET X=DE(23)
- SET DIC=DIE
- +34 DO KACLAU^TIUDD01(1301,X)
- DO KACLAU1^TIUDD01(1301,X)
- +35 SET X=DE(23)
- SET DIC=DIE
- +36 DO KACLEC^TIUDD01(1301,X)
- +37 SET X=DE(23)
- SET DIC=DIE
- +38 DO KACLSB^TIUDD01(1301,X)
