source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUDD8.m@ 668

Last change on this file since 668 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1TIUDD8 ; slc/KCM - Build menus in XUTL (file 8925.8) ;7/19/94 13:51 ;
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3SET ;From: Cross reference in file 8925.8, field 99 Entry: DA Exit: DA
4 ;NOTE: Lock ^TIU(8925.8,DA) when calling
5 Q:'$D(^TIU(8925.8,1,0))
6 I $P($G(^TIU(8925.8,1,99)),"^")=$P($G(^XUTL("XQORM","1;TIU(8925.8,",0)),"^") Q
7 N TIUCOL,TIUCCOL,TIUROW,TIUCROW,TIUPOS,TIUTOT,S1,S2,X,X1
8 K ^TMP("XQORM",$J) D KILL
9 S TIUCOL=3
10 S ^XUTL("XQORM","1;TIU(8925.8,","COL")=TIUCOL,TIUTOT=0,S1=""
11 F S S1=$O(^TIU(8925.8,"B",S1)) Q:S1']"" D
12 . S S2=+$O(^TIU(8925.8,"B",S1,0)) Q:+S2'>0
13 . S TIUTOT=TIUTOT+1,^TMP("XQORM",$J,TIUTOT,S2)=""
14 S TIUROW=TIUTOT\TIUCOL+$S(TIUTOT#TIUCOL:1,1:0),TIUCCOL=1,TIUCROW=0,S1=""
15 F S S1=$O(^TMP("XQORM",$J,S1)) Q:S1="" S S2=0 D ;S1 is sequence
16 . F S S2=$O(^TMP("XQORM",$J,S1,S2)) Q:S2'>0 D ;S2 is record #
17 . . S X=^TIU(8925.8,S2,0) ; X is the search category record
18 . . S TIUCROW=TIUCROW+1 I TIUCROW>TIUROW S TIUCROW=1,TIUCCOL=TIUCCOL+1
19 . . S TIUPOS=TIUCROW+(TIUCCOL/10)
20 . . S X1=$S($L($P(X,"^",3)):$P(X,"^",3),1:$$MIXED^TIULS($P(X,"^")))
21 . . S X1=$TR(X1,",=;-"," ") Q:'$L(X1)
22 . . S ^XUTL("XQORM",1_";TIU(8925.8,",TIUPOS,0)=+S1_"^"_+S2_"^"_X1_"^"_+S1
23 . . S ^XUTL("XQORM","1;TIU(8925.8,","B",$$UP(X1),TIUPOS)=""
24 . . I +S1 S ^XUTL("XQORM","1;TIU(8925.8,","B",+S1,TIUPOS)=1
25 S X=$H,^XUTL("XQORM","1;TIU(8925.8,",0)=X,^TIU(8925.8,1,99)=X
26 K ^TMP("XQORM",$J)
27 Q
28UP(X) ; Convert X to upper case
29 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
30KILL ; From: File 8925.8, Field 99 Entry: DA Exit: DA
31 K ^XUTL("XQORM","1;TIU(8925.8,") Q
32REDO ; Update TIMESTAMP on Record #1 when Display Name Changes
33 ; From: File 8925.8, Field .03 Entry: DA Exit: DA
34 N I,X S X=$H I $D(^TIU(8925.8,1,0)) S ^TIU(8925.8,1,99)=X,I=0
35 Q
Note: See TracBrowser for help on using the repository browser.