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)
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS93 771 printed Dec 13, 2024@02:44:27 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
