Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUPS93

TIUPS93.m

Go to the documentation of this file.
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