Routine: TIUPS93

TIUPS93 ; SLC/JER - Post-install for TIU*1*93 ;11:53 AM  27 Jan 2000

 ;;1.0;TEXT INTEGRATION UTILITIES;**93**;Jun 20, 1997

MAIN ; Main entry point for manual call

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

 D BMES^XPDUTL(" BACK-FILLING MIS-FILED SIGNATURES IN FILE 8925.7")

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

 D UPDATE^XPDID(0)

 F  S TIUDA=$O(^TIU(8925.7,TIUDA)) Q:+TIUDA'>0  D

 . D FIX(TIUDA)

 . S CNT=CNT+1

 . D:'(CNT#10) UPDATE^XPDID(CNT)

FIX(DA) ;Find/Fix mis-filed signature blocks

 N TIUD0

 S TIUD0=$G(^TIU(8925.7,DA,0))

 I +$P(TIUD0,U,5),$S('$L($P(TIUD0,U,6)):1,'$L($P(TIUD0,U,7)):1,1:0) D

 . N DIE,DR S DIE="^TIU(8925.7,"

 . S DR=".06///^S X=$$SIGNAME^TIULS(+$P(TIUD0,U,5));.07///^S X=$$SIGTITL^TIULS(+$P(TIUD0,U,5));.08////E"

 . D ^DIE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS93   771     printed  Apr 09, 2024@21:48:43                                                                                                                                                                                                      Page 2

TIUPS93   ; SLC/JER - Post-install for TIU*1*93 ;11:53 AM  27 Jan 2000

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**93**;Jun 20, 1997

MAIN      ; Main entry point for manual call

 +1        NEW TIUDA,XPDIDTOT,CNT

           SET (CNT,TIUDA)=0

 +2        DO BMES^XPDUTL(" BACK-FILLING MIS-FILED SIGNATURES IN FILE 8925.7")

 +3        SET XPDIDTOT=$PIECE(^TIU(8925.7,0),U,4)

 +4        DO UPDATE^XPDID(0)

 +5        FOR

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

               if +TIUDA'>0

                   QUIT

               Begin DoDot:1

 +6                DO FIX(TIUDA)

 +7                SET CNT=CNT+1

 +8                if '(CNT#10)

                       DO UPDATE^XPDID(CNT)

               End DoDot:1

 +9        QUIT

 +10      ;

FIX(DA)   ;Find/Fix mis-filed signature blocks

 +1        NEW TIUD0

 +2        SET TIUD0=$GET(^TIU(8925.7,DA,0))

 +3        IF +$PIECE(TIUD0,U,5)

               IF $SELECT('$LENGTH($PIECE(TIUD0,U,6)):1,'$LENGTH($PIECE(TIUD0,U,7)):1,1:0)

                   Begin DoDot:1

 +4                    NEW DIE,DR

                       SET DIE="^TIU(8925.7,"

 +5                    SET DR=".06///^S X=$$SIGNAME^TIULS(+$P(TIUD0,U,5));.07///^S X=$$SIGTITL^TIULS(+$P(TIUD0,U,5));.08////E"

 +6                    DO ^DIE

                   End DoDot:1

 +7        QUIT

TIUPS93.m