TIUPS115 ; SLC/JER - Post-install for TIU*1*115 ;4/20/2001 16:19
;;1.0;Text Integration Utilities;**115**;Jun 20, 1997
MAIN ; Control Subroutine
N TIUDA,TIUCNT,XPDIDTOT S (TIUCNT,TIUDA)=0
; Remove the existing ACL x-ref
K ^TIU(8925.1,"ACL")
D BMES^XPDUTL("BUILDING NEW ""ACL"" CROSS-REFERENCE ON FILE 8925.1")
S XPDIDTOT=$P(^TIU(8925.1,0),U,4),XPDIDVT=+$G(XPDIDVT)
D UPDATE^XPDID(0)
F S TIUDA=$O(^TIU(8925.1,TIUDA)) Q:+TIUDA'>0 D
. D XREF(TIUDA) S TIUCNT=+$G(TIUCNT)+1
. I '(TIUCNT#10) D UPDATE^XPDID(TIUCNT)
Q
XREF(DA) ; Call EN1^DIK to build "ACL" cross-reference on ^TIU(8925.1,
N DIK
S DIK="^TIU(8925.1,",DIK(1)=".01^ACL"
D EN1^DIK
S DIK="^TIU(8925.1,",DIK(1)=".02^ACL02"
D EN1^DIK
S DIK="^TIU(8925.1,",DIK(1)=".03^ACL03"
D EN1^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS115 781 printed Nov 22, 2024@17:53:54 Page 2
TIUPS115 ; SLC/JER - Post-install for TIU*1*115 ;4/20/2001 16:19
+1 ;;1.0;Text Integration Utilities;**115**;Jun 20, 1997
MAIN ; Control Subroutine
+1 NEW TIUDA,TIUCNT,XPDIDTOT
SET (TIUCNT,TIUDA)=0
+2 ; Remove the existing ACL x-ref
+3 KILL ^TIU(8925.1,"ACL")
+4 DO BMES^XPDUTL("BUILDING NEW ""ACL"" CROSS-REFERENCE ON FILE 8925.1")
+5 SET XPDIDTOT=$PIECE(^TIU(8925.1,0),U,4)
SET XPDIDVT=+$GET(XPDIDVT)
+6 DO UPDATE^XPDID(0)
+7 FOR
SET TIUDA=$ORDER(^TIU(8925.1,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:1
+8 DO XREF(TIUDA)
SET TIUCNT=+$GET(TIUCNT)+1
+9 IF '(TIUCNT#10)
DO UPDATE^XPDID(TIUCNT)
End DoDot:1
+10 QUIT
XREF(DA) ; Call EN1^DIK to build "ACL" cross-reference on ^TIU(8925.1,
+1 NEW DIK
+2 SET DIK="^TIU(8925.1,"
SET DIK(1)=".01^ACL"
+3 DO EN1^DIK
+4 SET DIK="^TIU(8925.1,"
SET DIK(1)=".02^ACL02"
+5 DO EN1^DIK
+6 SET DIK="^TIU(8925.1,"
SET DIK(1)=".03^ACL03"
+7 DO EN1^DIK
+8 QUIT
