- 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
- 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