TIUFD ; SLC/MAM - LM Screen D (Display) INIT, DS/BASICS,ITEMS,PARNT,BOILTX,TECH(LASTLIN) ;02/16/06
;;1.0;TEXT INTEGRATION UTILITIES;**14,184,211**;Jun 20, 1997;Build 26
;
HDR ; -- header code
S VALMHDR(1)=$$FHDR
HDRX ;
Q
;
FHDR() ; Function returns Type_Name for headers; Requires Array TIUFNOD0.
N NAME,TYPE
S NAME=$P(TIUFNOD0,U)
S TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
I TYPE'="" S TYPE=TYPE_" "
Q $$CENTER^TIUFL(TYPE_NAME,79)
;
INIT ; -- init variables and list array
N TEMPLATE
K ^TMP("TIUF3",$J),^TMP("TIUF3IDX",$J)
D CLEAN^VALM10
S VALMCNT=0 D DSBASICS(.VALMCNT)
INITX I $D(DTOUT) S VALMQUIT=1
Q
;
DSBASICS(LASTLIN) ; Set/Update Display Array TIUF3 starting with Basics.
; Requires LASTLIN = Last array line set, if setting array; = Last
;line to keep before resetting the rest if resetting array.
; Updates LASTLIN to Last array line set by this module.
; Requires CURRENT arrays TIUFINFO, TIUFNOD0.
;WARNING: +TIUFINFO may = 0!
; Any blanklines are set at the beginning, not the end, of the module.
N LINENO,CNT,TIUI,FILEDA,LP,LC,OWNER,DA,DR,TYPE,DIC,DIQ,FLDNO
S LINENO=LASTLIN
;If called to redisplay edited screen rather than by Init, kill array starting with Basics before resetting array.
S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
S FILEDA=TIUFINFO("FILEDA"),TYPE=$P(TIUFNOD0,U,4)
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Basics"_$S(TYPE'="O":" Note: Values preceded by * have been inherited",1:"")
K TIUFQ
S DIC=8925.1,DR=".01:.15;3.02;3.03;1501",DIQ(0)="I,E",DA=FILEDA,DIQ="TIUFQ" D EN^DIQ1 ;P184
F FLDNO=.01,1501,.02,.03,.04,.1,0,.13,.07,.05,.11,.08,.15,3.02,3.03 D
. I FLDNO=0,"NM"'[TIUFWHO Q ;Sets IFN line.
. I FLDNO=.1,TYPE'="CO" Q
. I FLDNO=.11,TIUFTMPL'="A"!(TYPE="O") Q
. I FLDNO=3.03,TYPE="CO"!(TYPE="O")!(TIUFWHO="C") Q
. I FLDNO=3.02,"N"'[TIUFWHO Q ; For now, include OK to Distribute only on Natl options. MAM
. D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
. Q
K TIUFQ
DSBAX S LASTLIN=LINENO Q:$D(DTOUT) D DSPARNT(.LASTLIN)
Q
;
DSPARNT(LASTLIN) ; Set/Update Display Array TIUF3 starting with Parents.
; See DSBASICS for required variables, etc.
N LINENO,CNT,TIUI,FILEDA,TIUREC,INFO,NODE0,TYPE,OLDLNO,PARENT
S (TIUFPLIN,LINENO)=LASTLIN,FILEDA=TIUFINFO("FILEDA"),TYPE=$P(TIUFNOD0,U,4)
I TYPE="O" G DSPAX
; Don't display parents if Template H or C, unless SHARED CO OR (mistakenly) Multiple Parents:
I "HC"[TIUFTMPL,'((TYPE="CO")&$P(TIUFNOD0,U,10)) S PARENT=+$O(^TIU(8925.1,"AD",FILEDA,0)) I '$O(^TIU(8925.1,"AD",FILEDA,PARENT)) G DSPAX
;If called to redisplay edited screen rather than by Init, kill array starting with Parents before resetting array.
S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
S FILEDA=TIUFINFO("FILEDA")
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Parent"_$S(TIUFNOD0("SHARE")="":"",1:"s")_$S($O(^TIU(8925.1,"AD",FILEDA,0)):" Type IFN Natl Status Owner",1:"")
I '$O(^TIU(8925.1,"AD",FILEDA,0)) S LASTLIN=LINENO G DSPAX
S TIUI=0,OLDLNO=LINENO
F S TIUI=$O(^TIU(8925.1,"AD",FILEDA,TIUI)) Q:'TIUI D G:$D(DTOUT) DSPAX
. S LINENO=LINENO+1 D NINFO^TIUFLLM(LINENO,TIUI,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(TIUI,.NODE0) Q:$D(DTOUT)
. I NODE0="" W !!," Entry "_FILEDA_" has parent missing from the file.",! S LINENO=LINENO-1 D PAUSE^TIUFXHLX Q
. D BUFENTRY^TIUFLLM2(.INFO,.NODE0,"80")
. Q
D UPDATE^TIUFLLM1("D",LINENO-OLDLNO,OLDLNO)
DSPAX S LASTLIN=LINENO Q:$D(DTOUT) D DSITEMS(.LASTLIN)
Q
;
DSITEMS(LASTLIN) ; Set/Update Display Array TIUF3 starting with Items.
; See DSBASICS for required variables, etc.
; Called by subtemplates D AND T
N LINENO,CNT,TIUI,FILEDA,TIUREC,ITEMS,OLDLNO,HASITEMS
S (TIUFILIN,LINENO)=LASTLIN
G:TIUFNOD0("ITEMS")="" DSITX ; Items is NA
;If called to redisplay edited screen rather than by Init, kill array starting with Items before resetting array.
S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
S FILEDA=TIUFINFO("FILEDA")
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
; HASITEMS may have changed if edited items:
S ITEMS=" Items",HASITEMS=$$HASITEMS^TIUFLF1(FILEDA) I HASITEMS S ITEMS=ITEMS_" (By Sequence if they have it, otherwise alphabetically by Menu Text)"
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=ITEMS
I 'HASITEMS G DSITX
S TIUREC=$$SETSTR^VALM1("Item","",2,37)
S:"NM"[TIUFWHO TIUREC=$$SETSTR^VALM1(" IFN",TIUREC,32,7)
S TIUREC=$$SETSTR^VALM1("Seq ",TIUREC,41,6),TIUREC=$$SETSTR^VALM1("Mnem",TIUREC,49,4),TIUREC=$$SETSTR^VALM1("Menu Text",TIUREC,55,26)
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=TIUREC,OLDLNO=LINENO
; Checked for items existing before entered EDIT/View. So items exist:
D BUFITEMS^TIUFLT("D",.TIUFINFO,.LINENO) G:$D(DTOUT) DSITX
D UPDATE^TIUFLLM1("D",LINENO-OLDLNO,OLDLNO)
DSITX S LASTLIN=LINENO Q:$D(DTOUT) D DSBOILTX(.LASTLIN)
Q
;
DSBOILTX(LASTLIN) ; Set Display Array TIUF3 starting with Boilerplte Text.
; Used by subtemplates D and X AND T
; See DSBASICS for required variables, etc.
N LINENO,CNT,TIUI,FILEDA,NAME
S (TIUFBLIN,LINENO)=LASTLIN
G:TIUFNOD0("BOILPT")="" DSBOX ; NA
;If called to redisplay edited screen rather than by Init, kill array starting with Boilpt Txt before resetting array.
S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
S FILEDA=TIUFINFO("FILEDA")
I TIUFSTMP'="X" S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)="",LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Boilerplate Text"
I TIUFNOD0("TYPE")="COMPONENT" S NAME=$P(TIUFNOD0,U),LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=NAME_":"
D SETBOIL^TIUFLD1(FILEDA,.LINENO)
D DSETBOIL^TIUFLD1(FILEDA,.LINENO)
DSBOX S LASTLIN=LINENO Q:$D(DTOUT) D:TIUFSTMP'="X" DSTECH(.LASTLIN)
Q
;
DSTECH(LASTLIN) ; Set/Update Display Array TIUF3 starting with Technical Flds.
; See DSBASICS for required variables, etc.
; Called by subtemp D and T
N LINENO,CNT,TIUI,FILEDA,FLDNO,PFILEDA,PNODE61,PCUSTOM,TYPE
N DIC,DR,DIQ,DA
S (TIUFTLIN,LINENO)=LASTLIN
I "NM"'[TIUFWHO G DSTEX
S TYPE=$P(TIUFNOD0,U,4) I TYPE="CO" G DSTEX
;If called to redisplay edited screen rather than by Init, kill array starting with Tech flds before resetting array.
S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
S FILEDA=TIUFINFO("FILEDA")
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Technical Fields"_$S(TYPE'="O":" Note: Values preceded by * have been inherited",1:"")
K TIUFQ
S DIC=8925.1,DR="4.1:4.45;4.6;4.7;4.9;5:9",DIQ(0)="I,E",DA=FILEDA,DIQ="TIUFQ" D EN^DIQ1
I TYPE="O" D SETFLD^TIUFLD(FILEDA,.LINENO,9) G DSTEX
S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0))
I TYPE="CL"!(TYPE="DC")!(TYPE="DOC") S PNODE61=$G(^TIU(8925.1,PFILEDA,6.1)),PCUSTOM=$P(PNODE61,U,4) I PCUSTOM="" D INHERIT^TIUFLD(FILEDA,0,6.14,"","","",.PCUSTOM)
F FLDNO=4.1,4.2,4.3,4.4,4.45,4.6,4.7,4.9,5,6,6.1,6.12,6.13,7,8,6.14 D
. I FLDNO=6.14,TYPE'="CL",TYPE'="DC" Q
. I FLDNO=6.1!(FLDNO=6.12)!(FLDNO=6.13),'$G(PCUSTOM) Q
. D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
. Q
DSTEX K TIUFQ S LASTLIN=LINENO Q:$D(DTOUT) D DSEMBED^TIUFD1(.LASTLIN)
Q
;
TIUFD ; SLC/MAM - LM Screen D (Display) INIT, DS/BASICS,ITEMS,PARNT,BOILTX,TECH(LASTLIN) ;02/16/06
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**14,184,211**;Jun 20, 1997;Build 26
+2 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$FHDR
HDRX ;
+1 QUIT
+2 ;
FHDR() ; Function returns Type_Name for headers; Requires Array TIUFNOD0.
+1 NEW NAME,TYPE
+2 SET NAME=$PIECE(TIUFNOD0,U)
+3 SET TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
+4 IF TYPE'=""
SET TYPE=TYPE_" "
+5 QUIT $$CENTER^TIUFL(TYPE_NAME,79)
+6 ;
INIT ; -- init variables and list array
+1 NEW TEMPLATE
+2 KILL ^TMP("TIUF3",$JOB),^TMP("TIUF3IDX",$JOB)
+3 DO CLEAN^VALM10
+4 SET VALMCNT=0
DO DSBASICS(.VALMCNT)
INITX IF $DATA(DTOUT)
SET VALMQUIT=1
+1 QUIT
+2 ;
DSBASICS(LASTLIN) ; Set/Update Display Array TIUF3 starting with Basics.
+1 ; Requires LASTLIN = Last array line set, if setting array; = Last
+2 ;line to keep before resetting the rest if resetting array.
+3 ; Updates LASTLIN to Last array line set by this module.
+4 ; Requires CURRENT arrays TIUFINFO, TIUFNOD0.
+5 ;WARNING: +TIUFINFO may = 0!
+6 ; Any blanklines are set at the beginning, not the end, of the module.
+7 NEW LINENO,CNT,TIUI,FILEDA,LP,LC,OWNER,DA,DR,TYPE,DIC,DIQ,FLDNO
+8 SET LINENO=LASTLIN
+9 ;If called to redisplay edited screen rather than by Init, kill array starting with Basics before resetting array.
+10 SET CNT=$ORDER(^TMP("TIUF3",$JOB,1000000),-1)
+11 FOR TIUI=LASTLIN+1:1:CNT
KILL ^TMP("TIUF3",$JOB,TIUI),^TMP("TIUF3IDX",$JOB,TIUI)
+12 SET FILEDA=TIUFINFO("FILEDA")
SET TYPE=$PIECE(TIUFNOD0,U,4)
+13 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=" Basics"_$SELECT(TYPE'="O":" Note: Values preceded by * have been inherited",1:"")
+14 KILL TIUFQ
+15 ;P184
SET DIC=8925.1
SET DR=".01:.15;3.02;3.03;1501"
SET DIQ(0)="I,E"
SET DA=FILEDA
SET DIQ="TIUFQ"
DO EN^DIQ1
+16 FOR FLDNO=.01,1501,.02,.03,.04,.1,0,.13,.07,.05,.11,.08,.15,3.02,3.03
Begin DoDot:1
+17 ;Sets IFN line.
IF FLDNO=0
IF "NM"'[TIUFWHO
QUIT
+18 IF FLDNO=.1
IF TYPE'="CO"
QUIT
+19 IF FLDNO=.11
IF TIUFTMPL'="A"!(TYPE="O")
QUIT
+20 IF FLDNO=3.03
IF TYPE="CO"!(TYPE="O")!(TIUFWHO="C")
QUIT
+21 ; For now, include OK to Distribute only on Natl options. MAM
IF FLDNO=3.02
IF "N"'[TIUFWHO
QUIT
+22 DO SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
+23 QUIT
End DoDot:1
+24 KILL TIUFQ
DSBAX SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
DO DSPARNT(.LASTLIN)
+1 QUIT
+2 ;
DSPARNT(LASTLIN) ; Set/Update Display Array TIUF3 starting with Parents.
+1 ; See DSBASICS for required variables, etc.
+2 NEW LINENO,CNT,TIUI,FILEDA,TIUREC,INFO,NODE0,TYPE,OLDLNO,PARENT
+3 SET (TIUFPLIN,LINENO)=LASTLIN
SET FILEDA=TIUFINFO("FILEDA")
SET TYPE=$PIECE(TIUFNOD0,U,4)
+4 IF TYPE="O"
GOTO DSPAX
+5 ; Don't display parents if Template H or C, unless SHARED CO OR (mistakenly) Multiple Parents:
+6 IF "HC"[TIUFTMPL
IF '((TYPE="CO")&$PIECE(TIUFNOD0,U,10))
SET PARENT=+$ORDER(^TIU(8925.1,"AD",FILEDA,0))
IF '$ORDER(^TIU(8925.1,"AD",FILEDA,PARENT))
GOTO DSPAX
+7 ;If called to redisplay edited screen rather than by Init, kill array starting with Parents before resetting array.
+8 SET CNT=$ORDER(^TMP("TIUF3",$JOB,1000000),-1)
+9 FOR TIUI=LASTLIN+1:1:CNT
KILL ^TMP("TIUF3",$JOB,TIUI),^TMP("TIUF3IDX",$JOB,TIUI)
+10 SET FILEDA=TIUFINFO("FILEDA")
+11 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
+12 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=" Parent"_$SELECT(TIUFNOD0("SHARE")="":"",1:"s")_$SELECT($ORDER(^TIU(8925.1,"AD",FILEDA,0)):" Type IFN Natl Status Owner",1:"")
+13 IF '$ORDER(^TIU(8925.1,"AD",FILEDA,0))
SET LASTLIN=LINENO
GOTO DSPAX
+14 SET TIUI=0
SET OLDLNO=LINENO
+15 FOR
SET TIUI=$ORDER(^TIU(8925.1,"AD",FILEDA,TIUI))
IF 'TIUI
QUIT
Begin DoDot:1
+16 SET LINENO=LINENO+1
DO NINFO^TIUFLLM(LINENO,TIUI,.INFO)
DO PARSE^TIUFLLM(.INFO)
DO NODE0ARR^TIUFLF(TIUI,.NODE0)
IF $DATA(DTOUT)
QUIT
+17 IF NODE0=""
WRITE !!," Entry "_FILEDA_" has parent missing from the file.",!
SET LINENO=LINENO-1
DO PAUSE^TIUFXHLX
QUIT
+18 DO BUFENTRY^TIUFLLM2(.INFO,.NODE0,"80")
+19 QUIT
End DoDot:1
IF $DATA(DTOUT)
GOTO DSPAX
+20 DO UPDATE^TIUFLLM1("D",LINENO-OLDLNO,OLDLNO)
DSPAX SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
DO DSITEMS(.LASTLIN)
+1 QUIT
+2 ;
DSITEMS(LASTLIN) ; Set/Update Display Array TIUF3 starting with Items.
+1 ; See DSBASICS for required variables, etc.
+2 ; Called by subtemplates D AND T
+3 NEW LINENO,CNT,TIUI,FILEDA,TIUREC,ITEMS,OLDLNO,HASITEMS
+4 SET (TIUFILIN,LINENO)=LASTLIN
+5 ; Items is NA
IF TIUFNOD0("ITEMS")=""
GOTO DSITX
+6 ;If called to redisplay edited screen rather than by Init, kill array starting with Items before resetting array.
+7 SET CNT=$ORDER(^TMP("TIUF3",$JOB,1000000),-1)
+8 FOR TIUI=LASTLIN+1:1:CNT
KILL ^TMP("TIUF3",$JOB,TIUI),^TMP("TIUF3IDX",$JOB,TIUI)
+9 SET FILEDA=TIUFINFO("FILEDA")
+10 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
+11 ; HASITEMS may have changed if edited items:
+12 SET ITEMS=" Items"
SET HASITEMS=$$HASITEMS^TIUFLF1(FILEDA)
IF HASITEMS
SET ITEMS=ITEMS_" (By Sequence if they have it, otherwise alphabetically by Menu Text)"
+13 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=ITEMS
+14 IF 'HASITEMS
GOTO DSITX
+15 SET TIUREC=$$SETSTR^VALM1("Item","",2,37)
+16 IF "NM"[TIUFWHO
SET TIUREC=$$SETSTR^VALM1(" IFN",TIUREC,32,7)
+17 SET TIUREC=$$SETSTR^VALM1("Seq ",TIUREC,41,6)
SET TIUREC=$$SETSTR^VALM1("Mnem",TIUREC,49,4)
SET TIUREC=$$SETSTR^VALM1("Menu Text",TIUREC,55,26)
+18 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=TIUREC
SET OLDLNO=LINENO
+19 ; Checked for items existing before entered EDIT/View. So items exist:
+20 DO BUFITEMS^TIUFLT("D",.TIUFINFO,.LINENO)
IF $DATA(DTOUT)
GOTO DSITX
+21 DO UPDATE^TIUFLLM1("D",LINENO-OLDLNO,OLDLNO)
DSITX SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
DO DSBOILTX(.LASTLIN)
+1 QUIT
+2 ;
DSBOILTX(LASTLIN) ; Set Display Array TIUF3 starting with Boilerplte Text.
+1 ; Used by subtemplates D and X AND T
+2 ; See DSBASICS for required variables, etc.
+3 NEW LINENO,CNT,TIUI,FILEDA,NAME
+4 SET (TIUFBLIN,LINENO)=LASTLIN
+5 ; NA
IF TIUFNOD0("BOILPT")=""
GOTO DSBOX
+6 ;If called to redisplay edited screen rather than by Init, kill array starting with Boilpt Txt before resetting array.
+7 SET CNT=$ORDER(^TMP("TIUF3",$JOB,1000000),-1)
+8 FOR TIUI=LASTLIN+1:1:CNT
KILL ^TMP("TIUF3",$JOB,TIUI),^TMP("TIUF3IDX",$JOB,TIUI)
+9 SET FILEDA=TIUFINFO("FILEDA")
+10 IF TIUFSTMP'="X"
SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=" Boilerplate Text"
+11 IF TIUFNOD0("TYPE")="COMPONENT"
SET NAME=$PIECE(TIUFNOD0,U)
SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=NAME_":"
+12 DO SETBOIL^TIUFLD1(FILEDA,.LINENO)
+13 DO DSETBOIL^TIUFLD1(FILEDA,.LINENO)
DSBOX SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
IF TIUFSTMP'="X"
DO DSTECH(.LASTLIN)
+1 QUIT
+2 ;
DSTECH(LASTLIN) ; Set/Update Display Array TIUF3 starting with Technical Flds.
+1 ; See DSBASICS for required variables, etc.
+2 ; Called by subtemp D and T
+3 NEW LINENO,CNT,TIUI,FILEDA,FLDNO,PFILEDA,PNODE61,PCUSTOM,TYPE
+4 NEW DIC,DR,DIQ,DA
+5 SET (TIUFTLIN,LINENO)=LASTLIN
+6 IF "NM"'[TIUFWHO
GOTO DSTEX
+7 SET TYPE=$PIECE(TIUFNOD0,U,4)
IF TYPE="CO"
GOTO DSTEX
+8 ;If called to redisplay edited screen rather than by Init, kill array starting with Tech flds before resetting array.
+9 SET CNT=$ORDER(^TMP("TIUF3",$JOB,1000000),-1)
+10 FOR TIUI=LASTLIN+1:1:CNT
KILL ^TMP("TIUF3",$JOB,TIUI),^TMP("TIUF3IDX",$JOB,TIUI)
+11 SET FILEDA=TIUFINFO("FILEDA")
+12 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
+13 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=" Technical Fields"_$SELECT(TYPE'="O":" Note: Values preceded by * have been inherited",1:"")
+14 KILL TIUFQ
+15 SET DIC=8925.1
SET DR="4.1:4.45;4.6;4.7;4.9;5:9"
SET DIQ(0)="I,E"
SET DA=FILEDA
SET DIQ="TIUFQ"
DO EN^DIQ1
+16 IF TYPE="O"
DO SETFLD^TIUFLD(FILEDA,.LINENO,9)
GOTO DSTEX
+17 SET PFILEDA=+$ORDER(^TIU(8925.1,"AD",FILEDA,0))
+18 IF TYPE="CL"!(TYPE="DC")!(TYPE="DOC")
SET PNODE61=$GET(^TIU(8925.1,PFILEDA,6.1))
SET PCUSTOM=$PIECE(PNODE61,U,4)
IF PCUSTOM=""
DO INHERIT^TIUFLD(FILEDA,0,6.14,"","","",.PCUSTOM)
+19 FOR FLDNO=4.1,4.2,4.3,4.4,4.45,4.6,4.7,4.9,5,6,6.1,6.12,6.13,7,8,6.14
Begin DoDot:1
+20 IF FLDNO=6.14
IF TYPE'="CL"
IF TYPE'="DC"
QUIT
+21 IF FLDNO=6.1!(FLDNO=6.12)!(FLDNO=6.13)
IF '$GET(PCUSTOM)
QUIT
+22 DO SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
+23 QUIT
End DoDot:1
DSTEX KILL TIUFQ
SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
DO DSEMBED^TIUFD1(.LASTLIN)
+1 QUIT
+2 ;
