BTIUODL.m

BTIUODL ; IHS/ITSC/LJF - LIST OBJECT DESCRIPTIONS ;02-Nov-2005 13:58;MGH

 ;;1.0;TEXT INTEGRATION UTILITIES;**1002,1003**;NOV 04, 2004

 ;IHS/ITSC/LJF 3/24/2005 PATCH 1002 - code was using incorrect IEN

 ;IHS/CIA/MGH - Modified to use the new field for description in the

 ;TIU DOCUMENT DEFINITION file

EN ; -- main entry point for BTIU LIST OBJECT DESC

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BTIU LIST OBJECT DESC")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 Q

 ;

INIT ; -- init variables and list array

 NEW OBJ,NAME,LINE,COUNT,IEN

 S (COUNT,VALMCNT)=0

 K ^TMP("BTIUODL",$J),^TMP("BTIUODL1",$J)

 ;

 ; first put objects into alpha order

 S OBJ=0 F  S OBJ=$O(^TIU(8925.1,"AT","O",OBJ)) Q:'OBJ  D

 . S NAME=$$GET1^DIQ(8925.1,OBJ,.01)

 . S ^TMP("BTIUODL1",$J,NAME,OBJ)=""

 ;

 ; pull from alpha list and build display line

 S NAME=0 F  S NAME=$O(^TMP("BTIUODL1",$J,NAME)) Q:NAME=""  D

 . S OBJ=0 F  S OBJ=$O(^TMP("BTIUODL1",$J,NAME,OBJ)) Q:'OBJ  D

 . . I $D(^TIU(8925.1,OBJ,9003130.1,0))>0 D

 . . .S COUNT=COUNT+1

 . . .S LINE=$J(COUNT,3)_$$SP(2)_$E(NAME,1,30)

 . . .;

 . . .S LINE=$$PAD(LINE,38)_$$GET1^DIQ(8925.1,OBJ,.07)   ;name & status

 . . .S LINE=$$PAD(LINE,49)_$E($$OWNER(OBJ),1,20)        ;object owner

 . . .;

 . . .D SET(LINE,OBJ,COUNT,.VALMCNT)

 . . .;

 . . .D SET($$SP(5)_"Method:  "_$$GET1^DIQ(8925.1,OBJ,9),OBJ,COUNT,.VALMCNT)  ;object method

 . . .;

 . . .; now loop thru description & place in array

 . . .D SET("",OBJ,COUNT,.VALMCNT)

 . . .S IEN=0 F  S IEN=$O(^TIU(8925.1,OBJ,9003130.1,IEN)) Q:'IEN  D

 . . . . D SET($$SP(5)_^TIU(8925.1,OBJ,9003130.1,IEN,0),OBJ,COUNT,.VALMCNT)

 . . .D SET("",OBJ,COUNT,.VALMCNT)

 ;

 I '$D(^TMP("BTIUODL",$J)) D SET("NO OBJECTS FOUND",0,1,1)

 Q

 ;

OWNER(IEN) ; return class or personal owner of object

 NEW X

 S X=$$GET1^DIQ(8925.1,IEN,.06) I X]"" Q X  ;class

 Q $$GET1^DIQ(8925.1,IEN,.05)               ;personal

 ;

SET(DATA,IEN,CNT,LINENUM) ; place display data into array

 S LINENUM=LINENUM+1

 S ^TMP("BTIUODL",$J,LINENUM,0)=DATA

 S ^TMP("BTIUODL",$J,"IDX",LINENUM,CNT)=IEN

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BTIUODL",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

PAD(DATA,LENGTH) ; pad length of data

 Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 ;

SP(NUM) ; pad spaces

 Q $$PAD(" ",NUM)

BTIUODL   ; IHS/ITSC/LJF - LIST OBJECT DESCRIPTIONS ;02-Nov-2005 13:58;MGH

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**1002,1003**;NOV 04, 2004

 +2       ;IHS/ITSC/LJF 3/24/2005 PATCH 1002 - code was using incorrect IEN

 +3       ;IHS/CIA/MGH - Modified to use the new field for description in the

 +4       ;TIU DOCUMENT DEFINITION file

EN        ; -- main entry point for BTIU LIST OBJECT DESC

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BTIU LIST OBJECT DESC")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ;

INIT      ; -- init variables and list array

 +1        NEW OBJ,NAME,LINE,COUNT,IEN

 +2        SET (COUNT,VALMCNT)=0

 +3        KILL ^TMP("BTIUODL",$JOB),^TMP("BTIUODL1",$JOB)

 +4       ;

 +5       ; first put objects into alpha order

 +6        SET OBJ=0

           FOR 

               SET OBJ=$ORDER(^TIU(8925.1,"AT","O",OBJ))

               IF 'OBJ

                   QUIT 

               Begin DoDot:1

 +7                SET NAME=$$GET1^DIQ(8925.1,OBJ,.01)

 +8                SET ^TMP("BTIUODL1",$JOB,NAME,OBJ)=""

               End DoDot:1

 +9       ;

 +10      ; pull from alpha list and build display line

 +11       SET NAME=0

           FOR 

               SET NAME=$ORDER(^TMP("BTIUODL1",$JOB,NAME))

               IF NAME=""

                   QUIT 

               Begin DoDot:1

 +12               SET OBJ=0

                   FOR 

                       SET OBJ=$ORDER(^TMP("BTIUODL1",$JOB,NAME,OBJ))

                       IF 'OBJ

                           QUIT 

                       Begin DoDot:2

 +13                       IF $DATA(^TIU(8925.1,OBJ,9003130.1,0))>0

                               Begin DoDot:3

 +14                               SET COUNT=COUNT+1

 +15                               SET LINE=$JUSTIFY(COUNT,3)_$$SP(2)_$EXTRACT(NAME,1,30)

 +16      ;

 +17      ;name & status

                                   SET LINE=$$PAD(LINE,38)_$$GET1^DIQ(8925.1,OBJ,.07)

 +18      ;object owner

                                   SET LINE=$$PAD(LINE,49)_$EXTRACT($$OWNER(OBJ),1,20)

 +19      ;

 +20                               DO SET(LINE,OBJ,COUNT,.VALMCNT)

 +21      ;

 +22      ;object method

                                   DO SET($$SP(5)_"Method:  "_$$GET1^DIQ(8925.1,OBJ,9),OBJ,COUNT,.VALMCNT)

 +23      ;

 +24      ; now loop thru description & place in array

 +25                               DO SET("",OBJ,COUNT,.VALMCNT)

 +26                               SET IEN=0

                                   FOR 

                                       SET IEN=$ORDER(^TIU(8925.1,OBJ,9003130.1,IEN))

                                       IF 'IEN

                                           QUIT 

                                       Begin DoDot:4

 +27                                       DO SET($$SP(5)_^TIU(8925.1,OBJ,9003130.1,IEN,0),OBJ,COUNT,.VALMCNT)

                                       End DoDot:4

 +28                               DO SET("",OBJ,COUNT,.VALMCNT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +29      ;

 +30       IF '$DATA(^TMP("BTIUODL",$JOB))

               DO SET("NO OBJECTS FOUND",0,1,1)

 +31       QUIT 

 +32      ;

OWNER(IEN) ; return class or personal owner of object

 +1        NEW X

 +2       ;class

           SET X=$$GET1^DIQ(8925.1,IEN,.06)

           IF X]""

               QUIT X

 +3       ;personal

           QUIT $$GET1^DIQ(8925.1,IEN,.05)

 +4       ;

SET(DATA,IEN,CNT,LINENUM) ; place display data into array

 +1        SET LINENUM=LINENUM+1

 +2        SET ^TMP("BTIUODL",$JOB,LINENUM,0)=DATA

 +3        SET ^TMP("BTIUODL",$JOB,"IDX",LINENUM,CNT)=IEN

 +4        QUIT 

 +5       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BTIUODL",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

PAD(DATA,LENGTH) ; pad length of data

 +1        QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 +2       ;

SP(NUM)   ; pad spaces

 +1        QUIT $$PAD(" ",NUM)