- TIUDD8 ; slc/KCM - Build menus in XUTL (file 8925.8) ;7/19/94 13:51 ;
- ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- SET ;From: Cross reference in file 8925.8, field 99 Entry: DA Exit: DA
- ;NOTE: Lock ^TIU(8925.8,DA) when calling
- Q:'$D(^TIU(8925.8,1,0))
- I $P($G(^TIU(8925.8,1,99)),"^")=$P($G(^XUTL("XQORM","1;TIU(8925.8,",0)),"^") Q
- N TIUCOL,TIUCCOL,TIUROW,TIUCROW,TIUPOS,TIUTOT,S1,S2,X,X1
- K ^TMP("XQORM",$J) D KILL
- S TIUCOL=3
- S ^XUTL("XQORM","1;TIU(8925.8,","COL")=TIUCOL,TIUTOT=0,S1=""
- F S S1=$O(^TIU(8925.8,"B",S1)) Q:S1']"" D
- . S S2=+$O(^TIU(8925.8,"B",S1,0)) Q:+S2'>0
- . S TIUTOT=TIUTOT+1,^TMP("XQORM",$J,TIUTOT,S2)=""
- S TIUROW=TIUTOT\TIUCOL+$S(TIUTOT#TIUCOL:1,1:0),TIUCCOL=1,TIUCROW=0,S1=""
- F S S1=$O(^TMP("XQORM",$J,S1)) Q:S1="" S S2=0 D ;S1 is sequence
- . F S S2=$O(^TMP("XQORM",$J,S1,S2)) Q:S2'>0 D ;S2 is record #
- . . S X=^TIU(8925.8,S2,0) ; X is the search category record
- . . S TIUCROW=TIUCROW+1 I TIUCROW>TIUROW S TIUCROW=1,TIUCCOL=TIUCCOL+1
- . . S TIUPOS=TIUCROW+(TIUCCOL/10)
- . . S X1=$S($L($P(X,"^",3)):$P(X,"^",3),1:$$MIXED^TIULS($P(X,"^")))
- . . S X1=$TR(X1,",=;-"," ") Q:'$L(X1)
- . . S ^XUTL("XQORM",1_";TIU(8925.8,",TIUPOS,0)=+S1_"^"_+S2_"^"_X1_"^"_+S1
- . . S ^XUTL("XQORM","1;TIU(8925.8,","B",$$UP(X1),TIUPOS)=""
- . . I +S1 S ^XUTL("XQORM","1;TIU(8925.8,","B",+S1,TIUPOS)=1
- S X=$H,^XUTL("XQORM","1;TIU(8925.8,",0)=X,^TIU(8925.8,1,99)=X
- K ^TMP("XQORM",$J)
- Q
- UP(X) ; Convert X to upper case
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- KILL ; From: File 8925.8, Field 99 Entry: DA Exit: DA
- K ^XUTL("XQORM","1;TIU(8925.8,") Q
- REDO ; Update TIMESTAMP on Record #1 when Display Name Changes
- ; From: File 8925.8, Field .03 Entry: DA Exit: DA
- N I,X S X=$H I $D(^TIU(8925.8,1,0)) S ^TIU(8925.8,1,99)=X,I=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDD8 1819 printed Feb 19, 2025@00:06:11 Page 2
- TIUDD8 ; slc/KCM - Build menus in XUTL (file 8925.8) ;7/19/94 13:51 ;
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- SET ;From: Cross reference in file 8925.8, field 99 Entry: DA Exit: DA
- +1 ;NOTE: Lock ^TIU(8925.8,DA) when calling
- +2 if '$DATA(^TIU(8925.8,1,0))
- QUIT
- +3 IF $PIECE($GET(^TIU(8925.8,1,99)),"^")=$PIECE($GET(^XUTL("XQORM","1;TIU(8925.8,",0)),"^")
- QUIT
- +4 NEW TIUCOL,TIUCCOL,TIUROW,TIUCROW,TIUPOS,TIUTOT,S1,S2,X,X1
- +5 KILL ^TMP("XQORM",$JOB)
- DO KILL
- +6 SET TIUCOL=3
- +7 SET ^XUTL("XQORM","1;TIU(8925.8,","COL")=TIUCOL
- SET TIUTOT=0
- SET S1=""
- +8 FOR
- SET S1=$ORDER(^TIU(8925.8,"B",S1))
- if S1']""
- QUIT
- Begin DoDot:1
- +9 SET S2=+$ORDER(^TIU(8925.8,"B",S1,0))
- if +S2'>0
- QUIT
- +10 SET TIUTOT=TIUTOT+1
- SET ^TMP("XQORM",$JOB,TIUTOT,S2)=""
- End DoDot:1
- +11 SET TIUROW=TIUTOT\TIUCOL+$SELECT(TIUTOT#TIUCOL:1,1:0)
- SET TIUCCOL=1
- SET TIUCROW=0
- SET S1=""
- +12 ;S1 is sequence
- FOR
- SET S1=$ORDER(^TMP("XQORM",$JOB,S1))
- if S1=""
- QUIT
- SET S2=0
- Begin DoDot:1
- +13 ;S2 is record #
- FOR
- SET S2=$ORDER(^TMP("XQORM",$JOB,S1,S2))
- if S2'>0
- QUIT
- Begin DoDot:2
- +14 ; X is the search category record
- SET X=^TIU(8925.8,S2,0)
- +15 SET TIUCROW=TIUCROW+1
- IF TIUCROW>TIUROW
- SET TIUCROW=1
- SET TIUCCOL=TIUCCOL+1
- +16 SET TIUPOS=TIUCROW+(TIUCCOL/10)
- +17 SET X1=$SELECT($LENGTH($PIECE(X,"^",3)):$PIECE(X,"^",3),1:$$MIXED^TIULS($PIECE(X,"^")))
- +18 SET X1=$TRANSLATE(X1,",=;-"," ")
- if '$LENGTH(X1)
- QUIT
- +19 SET ^XUTL("XQORM",1_";TIU(8925.8,",TIUPOS,0)=+S1_"^"_+S2_"^"_X1_"^"_+S1
- +20 SET ^XUTL("XQORM","1;TIU(8925.8,","B",$$UP(X1),TIUPOS)=""
- +21 IF +S1
- SET ^XUTL("XQORM","1;TIU(8925.8,","B",+S1,TIUPOS)=1
- End DoDot:2
- End DoDot:1
- +22 SET X=$HOROLOG
- SET ^XUTL("XQORM","1;TIU(8925.8,",0)=X
- SET ^TIU(8925.8,1,99)=X
- +23 KILL ^TMP("XQORM",$JOB)
- +24 QUIT
- UP(X) ; Convert X to upper case
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- KILL ; From: File 8925.8, Field 99 Entry: DA Exit: DA
- +1 KILL ^XUTL("XQORM","1;TIU(8925.8,")
- QUIT
- REDO ; Update TIMESTAMP on Record #1 when Display Name Changes
- +1 ; From: File 8925.8, Field .03 Entry: DA Exit: DA
- +2 NEW I,X
- SET X=$HOROLOG
- IF $DATA(^TIU(8925.8,1,0))
- SET ^TIU(8925.8,1,99)=X
- SET I=0
- +3 QUIT