TIUPS17.m

TIUPS17 ; SLC/JER - Post-install for TIU*1*7 and TIU*1*51 ;1/12/99@11:33:48

 ;;1.0;Text Integration Utilities;**7,51**;Jun 20, 1997

MAIN ; Control Subroutine

 N TIUDA,TIUCNT,XPDIDTOT S (TIUCNT,TIUDA)=0

 ; If "ACL" cross-reference has already been built, then exit

 ; I +$$XRDONE Q ** RESTORE THIS AFTER TEST v3 **

 K ^TIU(8925.1,"ACL") ; Remove the existing ACL x-ref

 D BMES^XPDUTL("BUILDING NEW ""ACL"" CROSS-REFERENCE ON FILE 8925.1")

 S XPDIDTOT=$P(^TIU(8925.1,0),U,4)

 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

 Q

XRDONE() ; Determine whether last entry in 8925.1 has been x-refed

 N TIULNM,TIUY S TIULNM="",TIUY=0

 S TIULNM=$O(^TIU(8925.1,"ACL",38,TIULNM),-1)

 I TIULNM]"WARN" S TIUY=1

 Q TIUY

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIUPS17   962     printed  Apr 09, 2024@21:49:09                                                                                                                                                                                                      Page 2

TIUPS17   ; SLC/JER - Post-install for TIU*1*7 and TIU*1*51 ;1/12/99@11:33:48

 +1       ;;1.0;Text Integration Utilities;**7,51**;Jun 20, 1997

MAIN      ; Control Subroutine

 +1        NEW TIUDA,TIUCNT,XPDIDTOT

           SET (TIUCNT,TIUDA)=0

 +2       ; If "ACL" cross-reference has already been built, then exit

 +3       ; I +$$XRDONE Q ** RESTORE THIS AFTER TEST v3 **

 +4       ; Remove the existing ACL x-ref

           KILL ^TIU(8925.1,"ACL")

 +5        DO BMES^XPDUTL("BUILDING NEW ""ACL"" CROSS-REFERENCE ON FILE 8925.1")

 +6        SET XPDIDTOT=$PIECE(^TIU(8925.1,0),U,4)

 +7        DO UPDATE^XPDID(0)

 +8        FOR 

               SET TIUDA=$ORDER(^TIU(8925.1,TIUDA))

               if +TIUDA'>0

                   QUIT 

               Begin DoDot:1

 +9                DO XREF(TIUDA)

                   SET TIUCNT=+$GET(TIUCNT)+1

 +10               IF '(TIUCNT#10)

                       DO UPDATE^XPDID(TIUCNT)

               End DoDot:1

 +11       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        QUIT 

XRDONE()  ; Determine whether last entry in 8925.1 has been x-refed

 +1        NEW TIULNM,TIUY

           SET TIULNM=""

           SET TIUY=0

 +2        SET TIULNM=$ORDER(^TIU(8925.1,"ACL",38,TIULNM),-1)

 +3        IF TIULNM]"WARN"

               SET TIUY=1

 +4        QUIT TIUY