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.
  1. 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
  1. MAIN ; Main entry point for manual call
  1. N TIUDA,XPDIDTOT,CNT S (CNT,TIUDA)=0
  1. D BMES^XPDUTL(" BACK-FILLING MIS-FILED SIGNATURES IN FILE 8925.7")
  1. S XPDIDTOT=$P(^TIU(8925.7,0),U,4)
  1. D UPDATE^XPDID(0)
  1. F S TIUDA=$O(^TIU(8925.7,TIUDA)) Q:+TIUDA'>0 D
  1. . D FIX(TIUDA)
  1. . S CNT=CNT+1
  1. . D:'(CNT#10) UPDATE^XPDID(CNT)
  1. Q
  1. ;
  1. FIX(DA) ;Find/Fix mis-filed signature blocks
  1. N TIUD0
  1. S TIUD0=$G(^TIU(8925.7,DA,0))
  1. I +$P(TIUD0,U,5),$S('$L($P(TIUD0,U,6)):1,'$L($P(TIUD0,U,7)):1,1:0) D
  1. . N DIE,DR S DIE="^TIU(8925.7,"
  1. . S DR=".06///^S X=$$SIGNAME^TIULS(+$P(TIUD0,U,5));.07///^S X=$$SIGTITL^TIULS(+$P(TIUD0,U,5));.08////E"
  1. . D ^DIE
  1. Q