TIUPS165.m

TIUPS165 ; SLC/MAM - After installing TIU*1*165;6/26/03

 ;;1.0;Text Integration Utilities;**165**;Jun 20, 1997

 ; Run this after installing patch 165.

 ;Use option: TIU165 DDEFS & RULES, PRF

 ; External References

 ;   DBIA 4127  MAIN^USRPS24

BEGIN ; Create DDEFS

 W !!,"This option creates Document Definitions, a User Class, and"

 W !,"a Business Rule for Patient Record Flags."

 W ! K IOP S %ZIS="Q" D ^%ZIS I POP K POP Q

 I $D(IO("Q")) K IO("Q") D  Q

 .S ZTRTN="MAIN^TIUPS165"

 .S ZTDESC="Create DDefs, User Class, Rules for Patient Record Flags - TIU*1*165"

 .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")

 .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE

 .D HOME^%ZIS

 U IO D MAIN,^%ZISC

 Q

 ;

MAIN ; Create DDEFS for Patient Record Flags

 ; -- Check for dups created after the install but before this option:

 K ^XTMP("TIU165","DUPS"),^TMP("TIU165",$J)

 D SETXTMP^TIUEN165

 N TIUDUPS,TMPCNT,SILENT S TMPCNT=0

 S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)=""

 S TMPCNT=1,^TMP("TIU165",$J,TMPCNT)="         ***** Document Definitions for PATIENT RECORD FLAGS *****"

 S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)=""

 S SILENT=1

 D TIUDUPS^TIUEN165(.TIUDUPS,SILENT)

 ; -- If potential duplicates exist, quit:

 I $G(TIUDUPS) D  G MAINX

 . S ^XTMP("TIU165","DUPS")=1

 . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="Duplicate problem.  See description for patch TIU*1*165,"

 . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="in the National Patch Module."

 ; -- Set file data, other data for DDEFS: 

 D SETDATA^TIU165D

 N NUM S NUM=0

 F  S NUM=$O(^XTMP("TIU165","BASICS",NUM)) Q:'NUM  D

 . N IEN,YDDEF,TIUDA

 . ; -- If DDEF was previously created by this patch,

 . ;    say so and quit:

 . S IEN=+$G(^XTMP("TIU165","BASICS",NUM,"DONE"))

 . I IEN D  Q

 . . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)=^XTMP("TIU165","FILEDATA",NUM,.04)_" "_^XTMP("TIU165","BASICS",NUM,"NAME")

 . . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="    was already created in a previous install."

 . . K ^XTMP("TIU165","FILEDATA",NUM)

 . . K ^XTMP("TIU165","DATA",NUM)

 . ; -- If not, create new DDEF:

 . S YDDEF=$$CREATE(NUM)

 . I +YDDEF'>0!($P(YDDEF,U,3)'=1) D  Q

 . . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="Couldn't create a "_^XTMP("TIU165","FILEDATA",NUM,.04)_" named "_^XTMP("TIU165","BASICS",NUM,"NAME")_".",TMPCNT=TMPCNT+1

 . . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="    Please contact National VistA Support for help."

 . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)=^XTMP("TIU165","FILEDATA",NUM,.04)_" named "_^XTMP("TIU165","BASICS",NUM,"NAME")

 . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="    created successfully."

 . S TIUDA=+YDDEF

 . ; -- File field data:

 . D FILE(NUM,TIUDA,.TMPCNT)

 . K ^XTMP("TIU165","FILEDATA",NUM)

 . ; -- Add item to parent:

 . D ADDITEM(NUM,TIUDA,.TMPCNT)

 . K ^XTMP("TIU165","DATA",NUM)

MAINX ;Exit

 S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)=""

 S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="                           *************"

 I '$G(^XTMP("TIU165","DUPS")) D MAIN^USRPS24

 D PRINT

 K ^TMP("TIU165",$J),^TMP("USR24",$J)

 Q

 ;

PRINT ; Print out results

 N TIUCNT,TIUCONT

 I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry

 I $E(IOST)="C" W @IOF,!

 S TIUCNT="",TIUCONT=1

 F  S TIUCNT=$O(^TMP("TIU165",$J,TIUCNT)) Q:TIUCNT=""  D  Q:'TIUCONT

 . S TIUCONT=$$SETCONT Q:'TIUCONT

 . W ^TMP("TIU165",$J,TIUCNT),!

 Q:'TIUCONT

 S TIUCNT=""

 F  S TIUCNT=$O(^TMP("USR24",$J,TIUCNT)) Q:TIUCNT=""  D  Q:'TIUCONT

 . S TIUCONT=$$SETCONT Q:'TIUCONT

 . W ^TMP("USR24",$J,TIUCNT),!

PRINTX Q

 ;

STOP() ;on screen paging check

 ; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0

 N DIR,Y,TIUCONT

 S DIR(0)="E" D ^DIR

 S TIUCONT=Y

 I TIUCONT W @IOF,!

 Q TIUCONT

 ;

SETCONT() ; D form feed, Set TIUCONT

 N TIUCONT

 S TIUCONT=1

 I $E(IOST)="C" G SETX:$Y+5<IOSL

 I $E(IOST)="C" S TIUCONT=$$STOP G SETX

 G:$Y+8<IOSL SETX

 W @IOF

SETX Q TIUCONT

 ;

PARENT(NUM) ; Return IEN of parent new DDEF should be added to

 N PIEN,PNUM

 ; Parent node has form:

 ; -- PIEN node = IEN of parent if known, or if not,

 ;    PNUM node = DDEF# of parent

 S PIEN=$G(^XTMP("TIU165","DATA",NUM,"PIEN"))

 ; -- If parent IEN is known, we're done:

 I +PIEN G PARENTX

 ; -- If not, get DDEF# of parent

 S PNUM=$G(^XTMP("TIU165","DATA",NUM,"PNUM"))

 I 'PNUM Q 0

 ; -- Get Parent IEN from "DONE" node, which was set

 ;    when parent was created:

 S PIEN=+$G(^XTMP("TIU165","BASICS",PNUM,"DONE"))

PARENTX Q PIEN

 ;

ADDITEM(NUM,TIUDA,TMPCNT)  ; Add DDEF to Parent; Set item fields

 N PIEN,MENUTXT,TIUFPRIV,TIUFISCR

 N DIE,DR

 S TIUFPRIV=1

 S PIEN=$$PARENT(NUM)

 I 'PIEN!'$D(^TIU(8925.1,PIEN,0))!'$D(^TIU(8925.1,TIUDA,0)) K PIEN G ADDX

 N DA,DIC,DLAYGO,X,Y

 N I,DIY

 S DA(1)=PIEN

 S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="LX"

 S DLAYGO=8925.14

 ;S X="`"_TIUDA

 ; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,

 ;    code finds item x under parent instead of creating a new item,

 ;    so don't use "`"_TIUDA:

 S X=^XTMP("TIU165","BASICS",NUM,"NAME")

 ; -- Make sure the DDEF it adds is TIUDA and not another w same name:

 S TIUFISCR=TIUDA ; activates screen on fld 10, Subfld .01 in DD

 D ^DIC I Y'>0!($P(Y,U,3)'=1) K PIEN G ADDX

 ; -- Set Menu Text:

 S MENUTXT=$G(^XTMP("TIU165","DATA",NUM,"MENUTXT"))

 I $L(MENUTXT) D

 . N DA,DIE,DR

 . N D,D0,DI,DQ

 . S DA(1)=PIEN

 . S DA=+Y,DIE=DIC

 . S DR="4////^S X=MENUTXT"

 . D ^DIE

ADDX ; -- Tell user about adding to parent:

 I '$G(PIEN) D

 . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="  Couldn't add entry to parent.  Please contact National VistA Support"

 . S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="    for help."

 E  S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="  Entry added to parent."

 Q

 ;

FILE(NUM,TIUDA,TMPCNT) ; File fields for new entry TIUDA

 ; Files ALL FIELDS set in "FILEDATA" nodes of ^XTMP:

 ;   ^XTMP("TIU165","FILEDATA",NUM,Field#)

 N TIUFPRIV,FDA,TIUERR

 S TIUFPRIV=1

 M FDA(8925.1,TIUDA_",")=^XTMP("TIU165","FILEDATA",NUM)

 D FILE^DIE("TE","FDA","TIUERR")

 I $D(TIUERR) S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="  Problem filing data for entry. Please contact National VistA Support."

 E  S TMPCNT=TMPCNT+1,^TMP("TIU165",$J,TMPCNT)="  Data for entry filed successfully."

 Q

 ;

CREATE(NUM) ; Create new DDEF entry

 N DIC,DLAYGO,DA,X,Y,TIUFPRIV

 S TIUFPRIV=1

 ;S (DIC,DLAYGO)="^TIU(8925.1,"

 ;CACHE won't take global root for DLAYGO; use file number:

 S DIC="^TIU(8925.1,",DLAYGO=8925.1

 S DIC(0)="LX",X=^XTMP("TIU165","BASICS",NUM,"NAME")

 S DIC("S")="I $P(^(0),U,4)="_""""_^XTMP("TIU165","BASICS",NUM,"INTTYPE")_""""

 D ^DIC

 ; -- If DDEF was just created, set "DONE" node = IEN

 I $P(Y,U,3)=1 S ^XTMP("TIU165","BASICS",NUM,"DONE")=+$G(Y)

 Q $G(Y)

TIUPS165  ; SLC/MAM - After installing TIU*1*165;6/26/03

 +1       ;;1.0;Text Integration Utilities;**165**;Jun 20, 1997

 +2       ; Run this after installing patch 165.

 +3       ;Use option: TIU165 DDEFS & RULES, PRF

 +4       ; External References

 +5       ;   DBIA 4127  MAIN^USRPS24

BEGIN     ; Create DDEFS

 +1        WRITE !!,"This option creates Document Definitions, a User Class, and"

 +2        WRITE !,"a Business Rule for Patient Record Flags."

 +3        WRITE !

           KILL IOP

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               KILL POP

               QUIT 

 +4        IF $DATA(IO("Q"))

               KILL IO("Q")

               Begin DoDot:1

 +5                SET ZTRTN="MAIN^TIUPS165"

 +6                SET ZTDESC="Create DDefs, User Class, Rules for Patient Record Flags - TIU*1*165"

 +7                DO ^%ZTLOAD

                   WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Canceled!")

 +8                KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE

 +9                DO HOME^%ZIS

               End DoDot:1

               QUIT 

 +10       USE IO

           DO MAIN

           DO ^%ZISC

 +11       QUIT 

 +12      ;

MAIN      ; Create DDEFS for Patient Record Flags

 +1       ; -- Check for dups created after the install but before this option:

 +2        KILL ^XTMP("TIU165","DUPS"),^TMP("TIU165",$JOB)

 +3        DO SETXTMP^TIUEN165

 +4        NEW TIUDUPS,TMPCNT,SILENT

           SET TMPCNT=0

 +5        SET TMPCNT=TMPCNT+1

           SET ^TMP("TIU165",$JOB,TMPCNT)=""

 +6        SET TMPCNT=1

           SET ^TMP("TIU165",$JOB,TMPCNT)="         ***** Document Definitions for PATIENT RECORD FLAGS *****"

 +7        SET TMPCNT=TMPCNT+1

           SET ^TMP("TIU165",$JOB,TMPCNT)=""

 +8        SET SILENT=1

 +9        DO TIUDUPS^TIUEN165(.TIUDUPS,SILENT)

 +10      ; -- If potential duplicates exist, quit:

 +11       IF $GET(TIUDUPS)

               Begin DoDot:1

 +12               SET ^XTMP("TIU165","DUPS")=1

 +13               SET TMPCNT=TMPCNT+1

                   SET ^TMP("TIU165",$JOB,TMPCNT)="Duplicate problem.  See description for patch TIU*1*165,"

 +14               SET TMPCNT=TMPCNT+1

                   SET ^TMP("TIU165",$JOB,TMPCNT)="in the National Patch Module."

               End DoDot:1

               GOTO MAINX

 +15      ; -- Set file data, other data for DDEFS: 

 +16       DO SETDATA^TIU165D

 +17       NEW NUM

           SET NUM=0

 +18       FOR 

               SET NUM=$ORDER(^XTMP("TIU165","BASICS",NUM))

               IF 'NUM

                   QUIT 

               Begin DoDot:1

 +19               NEW IEN,YDDEF,TIUDA

 +20      ; -- If DDEF was previously created by this patch,

 +21      ;    say so and quit:

 +22               SET IEN=+$GET(^XTMP("TIU165","BASICS",NUM,"DONE"))

 +23               IF IEN

                       Begin DoDot:2

 +24                       SET TMPCNT=TMPCNT+1

                           SET ^TMP("TIU165",$JOB,TMPCNT)=^XTMP("TIU165","FILEDATA",NUM,.04)_" "_^XTMP("TIU165","BASICS",NUM,"NAME")

 +25                       SET TMPCNT=TMPCNT+1

                           SET ^TMP("TIU165",$JOB,TMPCNT)="    was already created in a previous install."

 +26                       KILL ^XTMP("TIU165","FILEDATA",NUM)

 +27                       KILL ^XTMP("TIU165","DATA",NUM)

                       End DoDot:2

                       QUIT 

 +28      ; -- If not, create new DDEF:

 +29               SET YDDEF=$$CREATE(NUM)

 +30               IF +YDDEF'>0!($PIECE(YDDEF,U,3)'=1)

                       Begin DoDot:2

 +31                       SET TMPCNT=TMPCNT+1

                           SET ^TMP("TIU165",$JOB,TMPCNT)="Couldn't create a "_^XTMP("TIU165","FILEDATA",NUM,.04)_" named "_^XTMP("TIU165","BASICS",NUM,"NAME")_"."

                           SET TMPCNT=TMPCNT+1

 +32                       SET TMPCNT=TMPCNT+1

                           SET ^TMP("TIU165",$JOB,TMPCNT)="    Please contact National VistA Support for help."

                       End DoDot:2

                       QUIT 

 +33               SET TMPCNT=TMPCNT+1

                   SET ^TMP("TIU165",$JOB,TMPCNT)=^XTMP("TIU165","FILEDATA",NUM,.04)_" named "_^XTMP("TIU165","BASICS",NUM,"NAME")

 +34               SET TMPCNT=TMPCNT+1

                   SET ^TMP("TIU165",$JOB,TMPCNT)="    created successfully."

 +35               SET TIUDA=+YDDEF

 +36      ; -- File field data:

 +37               DO FILE(NUM,TIUDA,.TMPCNT)

 +38               KILL ^XTMP("TIU165","FILEDATA",NUM)

 +39      ; -- Add item to parent:

 +40               DO ADDITEM(NUM,TIUDA,.TMPCNT)

 +41               KILL ^XTMP("TIU165","DATA",NUM)

               End DoDot:1

MAINX     ;Exit

 +1        SET TMPCNT=TMPCNT+1

           SET ^TMP("TIU165",$JOB,TMPCNT)=""

 +2        SET TMPCNT=TMPCNT+1

           SET ^TMP("TIU165",$JOB,TMPCNT)="                           *************"

 +3        IF '$GET(^XTMP("TIU165","DUPS"))

               DO MAIN^USRPS24

 +4        DO PRINT

 +5        KILL ^TMP("TIU165",$JOB),^TMP("USR24",$JOB)

 +6        QUIT 

 +7       ;

PRINT     ; Print out results

 +1        NEW TIUCNT,TIUCONT

 +2       ; Tell TaskMan to delete Task log entry

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        IF $EXTRACT(IOST)="C"

               WRITE @IOF,!

 +4        SET TIUCNT=""

           SET TIUCONT=1

 +5        FOR 

               SET TIUCNT=$ORDER(^TMP("TIU165",$JOB,TIUCNT))

               IF TIUCNT=""

                   QUIT 

               Begin DoDot:1

 +6                SET TIUCONT=$$SETCONT

                   IF 'TIUCONT

                       QUIT 

 +7                WRITE ^TMP("TIU165",$JOB,TIUCNT),!

               End DoDot:1

               IF 'TIUCONT

                   QUIT 

 +8        IF 'TIUCONT

               QUIT 

 +9        SET TIUCNT=""

 +10       FOR 

               SET TIUCNT=$ORDER(^TMP("USR24",$JOB,TIUCNT))

               IF TIUCNT=""

                   QUIT 

               Begin DoDot:1

 +11               SET TIUCONT=$$SETCONT

                   IF 'TIUCONT

                       QUIT 

 +12               WRITE ^TMP("USR24",$JOB,TIUCNT),!

               End DoDot:1

               IF 'TIUCONT

                   QUIT 

PRINTX     QUIT 

 +1       ;

STOP()    ;on screen paging check

 +1       ; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0

 +2        NEW DIR,Y,TIUCONT

 +3        SET DIR(0)="E"

           DO ^DIR

 +4        SET TIUCONT=Y

 +5        IF TIUCONT

               WRITE @IOF,!

 +6        QUIT TIUCONT

 +7       ;

SETCONT() ; D form feed, Set TIUCONT

 +1        NEW TIUCONT

 +2        SET TIUCONT=1

 +3        IF $EXTRACT(IOST)="C"

               IF $Y+5<IOSL

                   GOTO SETX

 +4        IF $EXTRACT(IOST)="C"

               SET TIUCONT=$$STOP

               GOTO SETX

 +5        IF $Y+8<IOSL

               GOTO SETX

 +6        WRITE @IOF

SETX       QUIT TIUCONT

 +1       ;

PARENT(NUM) ; Return IEN of parent new DDEF should be added to

 +1        NEW PIEN,PNUM

 +2       ; Parent node has form:

 +3       ; -- PIEN node = IEN of parent if known, or if not,

 +4       ;    PNUM node = DDEF# of parent

 +5        SET PIEN=$GET(^XTMP("TIU165","DATA",NUM,"PIEN"))

 +6       ; -- If parent IEN is known, we're done:

 +7        IF +PIEN

               GOTO PARENTX

 +8       ; -- If not, get DDEF# of parent

 +9        SET PNUM=$GET(^XTMP("TIU165","DATA",NUM,"PNUM"))

 +10       IF 'PNUM

               QUIT 0

 +11      ; -- Get Parent IEN from "DONE" node, which was set

 +12      ;    when parent was created:

 +13       SET PIEN=+$GET(^XTMP("TIU165","BASICS",PNUM,"DONE"))

PARENTX    QUIT PIEN

 +1       ;

ADDITEM(NUM,TIUDA,TMPCNT) ; Add DDEF to Parent; Set item fields

 +1        NEW PIEN,MENUTXT,TIUFPRIV,TIUFISCR

 +2        NEW DIE,DR

 +3        SET TIUFPRIV=1

 +4        SET PIEN=$$PARENT(NUM)

 +5        IF 'PIEN!'$DATA(^TIU(8925.1,PIEN,0))!'$DATA(^TIU(8925.1,TIUDA,0))

               KILL PIEN

               GOTO ADDX

 +6        NEW DA,DIC,DLAYGO,X,Y

 +7        NEW I,DIY

 +8        SET DA(1)=PIEN

 +9        SET DIC="^TIU(8925.1,"_DA(1)_",10,"

           SET DIC(0)="LX"

 +10       SET DLAYGO=8925.14

 +11      ;S X="`"_TIUDA

 +12      ; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,

 +13      ;    code finds item x under parent instead of creating a new item,

 +14      ;    so don't use "`"_TIUDA:

 +15       SET X=^XTMP("TIU165","BASICS",NUM,"NAME")

 +16      ; -- Make sure the DDEF it adds is TIUDA and not another w same name:

 +17      ; activates screen on fld 10, Subfld .01 in DD

           SET TIUFISCR=TIUDA

 +18       DO ^DIC

           IF Y'>0!($PIECE(Y,U,3)'=1)

               KILL PIEN

               GOTO ADDX

 +19      ; -- Set Menu Text:

 +20       SET MENUTXT=$GET(^XTMP("TIU165","DATA",NUM,"MENUTXT"))

 +21       IF $LENGTH(MENUTXT)

               Begin DoDot:1

 +22               NEW DA,DIE,DR

 +23               NEW D,D0,DI,DQ

 +24               SET DA(1)=PIEN

 +25               SET DA=+Y

                   SET DIE=DIC

 +26               SET DR="4////^S X=MENUTXT"

 +27               DO ^DIE

               End DoDot:1

ADDX      ; -- Tell user about adding to parent:

 +1        IF '$GET(PIEN)

               Begin DoDot:1

 +2                SET TMPCNT=TMPCNT+1

                   SET ^TMP("TIU165",$JOB,TMPCNT)="  Couldn't add entry to parent.  Please contact National VistA Support"

 +3                SET TMPCNT=TMPCNT+1

                   SET ^TMP("TIU165",$JOB,TMPCNT)="    for help."

               End DoDot:1

 +4       IF '$TEST

               SET TMPCNT=TMPCNT+1

               SET ^TMP("TIU165",$JOB,TMPCNT)="  Entry added to parent."

 +5        QUIT 

 +6       ;

FILE(NUM,TIUDA,TMPCNT) ; File fields for new entry TIUDA

 +1       ; Files ALL FIELDS set in "FILEDATA" nodes of ^XTMP:

 +2       ;   ^XTMP("TIU165","FILEDATA",NUM,Field#)

 +3        NEW TIUFPRIV,FDA,TIUERR

 +4        SET TIUFPRIV=1

 +5        MERGE FDA(8925.1,TIUDA_",")=^XTMP("TIU165","FILEDATA",NUM)

 +6        DO FILE^DIE("TE","FDA","TIUERR")

 +7        IF $DATA(TIUERR)

               SET TMPCNT=TMPCNT+1

               SET ^TMP("TIU165",$JOB,TMPCNT)="  Problem filing data for entry. Please contact National VistA Support."

 +8       IF '$TEST

               SET TMPCNT=TMPCNT+1

               SET ^TMP("TIU165",$JOB,TMPCNT)="  Data for entry filed successfully."

 +9        QUIT 

 +10      ;

CREATE(NUM) ; Create new DDEF entry

 +1        NEW DIC,DLAYGO,DA,X,Y,TIUFPRIV

 +2        SET TIUFPRIV=1

 +3       ;S (DIC,DLAYGO)="^TIU(8925.1,"

 +4       ;CACHE won't take global root for DLAYGO; use file number:

 +5        SET DIC="^TIU(8925.1,"

           SET DLAYGO=8925.1

 +6        SET DIC(0)="LX"

           SET X=^XTMP("TIU165","BASICS",NUM,"NAME")

 +7        SET DIC("S")="I $P(^(0),U,4)="_""""_^XTMP("TIU165","BASICS",NUM,"INTTYPE")_""""

 +8        DO ^DIC

 +9       ; -- If DDEF was just created, set "DONE" node = IEN

 +10       IF $PIECE(Y,U,3)=1

               SET ^XTMP("TIU165","BASICS",NUM,"DONE")=+$GET(Y)

 +11       QUIT $GET(Y)