Routine: TIUFD

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 ;

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

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)

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)

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)

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)

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)

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       ;

TIUFD.m