Routine: BTIUDDL

BTIUDDL ; IHS/ITSC/LJF - LIST DOC DEFINITIONS ;

 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

EN ; -- main entry point for BTIU LIST DOC DEFS

 D EN^VALM("BTIU LIST DOC DEFS")

HDR ; -- header code

 S VALMHDR(1)=$$SP(10)_"CLINICAL DOCUMENTS HIERARCHY AT "_$$SITE

INIT ; -- init variables and list array

 D MSG^BTIUU("COMPILING LIST OF DOCUMENTS TITLES...",2,0,0)

 NEW TIUCNT,TIULVL K ^TMP("BTIUDDL",$J)

 S (TIUCNT,TIULVL)=0

 D DOCNM(38),ITEMS(38),OBJECTS

 S VALMCNT=TIUCNT

 S VALMSG=$$VALMSG^BTIUU

DOCNM(TIUN) ; -- sets up display line for item

 NEW TIUZ,TIUTM,X

 D ENP^XBDIQ1(8925.1,TIUN,".01:.04;.07","TIUZ(","I")

 I TIUZ(.04,"I")="CO"!(TIUZ(.04,"I")="O") Q  ;components & objects

 I TIUZ(.04,"I")'="DOC",'$O(^TIU(8925.1,TIUN,10,0)) Q  ;not used

 I TIUZ(.07)'="ACTIVE" Q  ;must be active

 S LINE=$$PAD($$SP(TIULVL)_$E($$NAME,1,50),55)_$$SP(5)

 S LINE=LINE_$S($O(^TIU(8925.1,TIUN,"HEAD",0)):"YES",1:" ")  ;okay to dictate

 D:(TIUZ(.04,"I")'="DOC") SET("") D:(TIUZ(.04,"I")="CL") SET("")

 D SET(LINE)

ITEMS(TIUN) ; -- finds all items tied to document definition

 NEW TIUTM,TIUX,TIUZZ,Y

 S TIULVL=$G(TIULVL)+1               ;increment level

 S TIUTM=0 F  S TIUTM=$O(^TIU(8925.1,TIUN,10,TIUTM)) Q:'TIUTM  D

 . S TIUX=+^TIU(8925.1,TIUN,10,TIUTM,0) Q:'TIUX

 . S TIUZZ($$GET1^DIQ(8925.1,TIUX,.01))=TIUX ;put in alpha order

 S TIUX=0 F  S TIUX=$O(TIUZZ(TIUX)) Q:TIUX=""  D

 . S Y=TIUZZ(TIUX) D DOCNM(Y),ITEMS(Y)  ;process this level

 S TIULVL=TIULVL-1                   ;return to previous level

OBJECTS ; -- list all available objects

HELP ; -- help code

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

EXIT ; -- exit code

EXPND ; -- expand code

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

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

SP(NUM) ; -- SUBRTN to pad spaces

 Q $$PAD(" ",NUM)

SET(LINE) ; -- SUBRTN to set data line into ^tmp

 S TIUCNT=TIUCNT+1

 S ^TMP("BTIUDDL",$J,TIUCNT,0)=LINE

 S ^TMP("BTIUDDL",$J,"IDX",TIUCNT,TIUCNT)=""

SITE() ; -- returns site name

 Q $$GET1^DIQ(4,+DUZ(2),.01)

NAME() ; -- returns name

 Q TIUZ(.01)_$S(TIUZ(.04,"I")="CL":" CLASS",TIUZ(.04,"I")="DC":" DOCUMENT CLASS",1:"")

BTIUDDL   ; IHS/ITSC/LJF - LIST DOC DEFINITIONS ;

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

 +2       ;

EN        ; -- main entry point for BTIU LIST DOC DEFS

 +1        DO EN^VALM("BTIU LIST DOC DEFS")

 +2        QUIT

 +3       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)=$$SP(10)_"CLINICAL DOCUMENTS HIERARCHY AT "_$$SITE

 +2        QUIT

 +3       ;

INIT      ; -- init variables and list array

 +1        DO MSG^BTIUU("COMPILING LIST OF DOCUMENTS TITLES...",2,0,0)

 +2        NEW TIUCNT,TIULVL

           KILL ^TMP("BTIUDDL",$JOB)

 +3        SET (TIUCNT,TIULVL)=0

 +4        DO DOCNM(38)

           DO ITEMS(38)

           DO OBJECTS

 +5        SET VALMCNT=TIUCNT

 +6        SET VALMSG=$$VALMSG^BTIUU

 +7        QUIT

 +8       ;

DOCNM(TIUN) ; -- sets up display line for item

 +1        NEW TIUZ,TIUTM,X

 +2        DO ENP^XBDIQ1(8925.1,TIUN,".01:.04;.07","TIUZ(","I")

 +3       ;components & objects

           IF TIUZ(.04,"I")="CO"!(TIUZ(.04,"I")="O")

               QUIT

 +4       ;not used

           IF TIUZ(.04,"I")'="DOC"

               IF '$ORDER(^TIU(8925.1,TIUN,10,0))

                   QUIT

 +5       ;must be active

           IF TIUZ(.07)'="ACTIVE"

               QUIT

 +6        SET LINE=$$PAD($$SP(TIULVL)_$EXTRACT($$NAME,1,50),55)_$$SP(5)

 +7       ;okay to dictate

           SET LINE=LINE_$SELECT($ORDER(^TIU(8925.1,TIUN,"HEAD",0)):"YES",1:" ")

 +8        IF (TIUZ(.04,"I")'="DOC")

               DO SET("")

           IF (TIUZ(.04,"I")="CL")

               DO SET("")

 +9        DO SET(LINE)

 +10       QUIT

 +11      ;

ITEMS(TIUN) ; -- finds all items tied to document definition

 +1        NEW TIUTM,TIUX,TIUZZ,Y

 +2       ;increment level

           SET TIULVL=$GET(TIULVL)+1

 +3        SET TIUTM=0

FOR

               SET TIUTM=$ORDER(^TIU(8925.1,TIUN,10,TIUTM))

               IF 'TIUTM

                   QUIT

               Begin DoDot:1

 +4                SET TIUX=+^TIU(8925.1,TIUN,10,TIUTM,0)

                   IF 'TIUX

                       QUIT

 +5       ;put in alpha order

                   SET TIUZZ($$GET1^DIQ(8925.1,TIUX,.01))=TIUX

               End DoDot:1

 +6       ;

 +7        SET TIUX=0

FOR

               SET TIUX=$ORDER(TIUZZ(TIUX))

               IF TIUX=""

                   QUIT

               Begin DoDot:1

 +8       ;process this level

                   SET Y=TIUZZ(TIUX)

                   DO DOCNM(Y)

                   DO ITEMS(Y)

               End DoDot:1

 +9       ;return to previous level

           SET TIULVL=TIULVL-1

 +10       QUIT

 +11      ;

OBJECTS   ; -- list all available objects

 +1        QUIT

 +2       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT

 +3       ;

EXIT      ; -- exit code

 +1        QUIT

 +2       ;

EXPND     ; -- expand code

 +1        QUIT

 +2       ;

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

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

 +2       ;

SP(NUM)   ; -- SUBRTN to pad spaces

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

 +2       ;

SET(LINE) ; -- SUBRTN to set data line into ^tmp

 +1        SET TIUCNT=TIUCNT+1

 +2        SET ^TMP("BTIUDDL",$JOB,TIUCNT,0)=LINE

 +3        SET ^TMP("BTIUDDL",$JOB,"IDX",TIUCNT,TIUCNT)=""

 +4        QUIT

 +5       ;

SITE()    ; -- returns site name

 +1        QUIT $$GET1^DIQ(4,+DUZ(2),.01)

 +2       ;

NAME()    ; -- returns name

 +1        QUIT TIUZ(.01)_$SELECT(TIUZ(.04,"I")="CL":" CLASS",TIUZ(.04,"I")="DC":" DOCUMENT CLASS",1:"")

BTIUDDL.m