PXRMCOPY ;SLC/PKR,PJH - Copy various reminder files. ;Jun 29, 2021@11:59:53
;;2.0;CLINICAL REMINDERS;**6,12,26,45,71**;Feb 04, 2005;Build 43
;
;=====================================================
COPY(PROMPT,ROOT,WHAT) ;Copy an entry of ROOT into a new entry.
N DIROUT,DTOUT,DUOUT
F D GETORGR Q:$D(DIROUT) Q:$D(DTOUT)
Q
;
;=====================================================
GETORGR ;Look-up logic to get and copy source entry to destination.
N DIC,IENN,IENO,Y
S DIC=ROOT,DIC(0)="AEMQ",DIC("A")=PROMPT
W !
D ^DIC
I $D(DUOUT)!$D(DTOUT) S DIROUT="" Q
S IENO=$P(Y,U,1)
I IENO=-1 S DIROUT="" Q
D GETORGRC(IENO,.IENN,ROOT,WHAT,0)
Q
;
GETORGRC(IENO,IENN,ROOT,WHAT,SKIP) ;
N DA,DIC,DIE,DIK,DIR,DIRUT,FAIL,FDA,FIELDLEN,FILE
N HASGF,IENS,MSG,NAME,ORGNAME,X,Y
; reminder dialog checks
S DIC=ROOT,FAIL=0
N DTYP,LFIND,LOCK
I ROOT="^PXRMD(801.41," D
.;Check for Uneditable flag
.S LOCK=$P($G(^PXRMD(801.41,IENO,100)),U,4)
.S LFIND=$P($G(^PXRMD(801.41,IENO,1)),U,5)
.S DTYP=$P($G(^PXRMD(801.41,IENO,0)),U,4)
.S HASGF=$$HASGF(IENO)
.I HASGF D
..I $P($G(^PXRMD(801.41,IENO,0)),U)="VA-TICKLER ELEMENT" Q
..W !,"This item cannot be copied." S FAIL=1 H 2 Q
.I LOCK=1,'$G(PXRMINST),DTYP="G" D Q
..W !,"This item cannot be copied." S FAIL=1 H 2
.I LOCK=1,$G(LFIND)'="",$G(LFIND)'["ORD",'$G(PXRMINST),DTYP'="G" D Q
..W !,"This item cannot be copied." S FAIL=1 H 2
;
I FAIL=1 Q
;Set the starting place for additions.
D SETSTART^PXRMCOPY(DIC)
S IENN=$$GETFOIEN(ROOT)
D MERGE(IENN,IENO,ROOT)
;
;Get the new name.
S ORGNAME=$P(@(ROOT_IENO_",0)"),U,1)
S FILE=$$FNFR^PXRMUTIL(ROOT)
S FIELDLEN=$$GET1^DID(FILE,.01,"","FIELD LENGTH")
S DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
S DIR("A")="PLEASE ENTER A UNIQUE NAME"
GETNAM D ^DIR
I $D(DIRUT) D DELETE(ROOT,IENN) Q
S NAME=Y
;
;Make sure the new name is valid.
I '$$VNAME^PXRMINTR(NAME) G GETNAM
;
;Change to the new name.
S IENS=IENN_","
S FDA(FILE,IENS,.01)=NAME
K MSG
D FILE^DIE("","FDA","MSG")
;Check to make sure the name was not a duplicate.
I $G(MSG("DIERR",1))=740 D G GETNAM
. W !,NAME," is not a unique name!"
;Change the class to local and delete the sponsor.
D SCAS(FILE,IENN,"L","")
;Initialize the edit history.
D INIEH(FILE,ROOT,IENN,IENO)
;
;Reindex the cross-references.
S DIK=ROOT,DA=IENN
D IX^DIK
I $G(PXRMDANY)=1 D Q
.W !!,"Completed copy of '"_ORGNAME_"'"
.W !,"into '"_NAME_"'",! H 2
.I $P(@(ROOT_IENN_",0)"),U,4)="P" D
..;Allow PXRM prompts to be changed into forced values
..N ANS,TEXT
..S TEXT="Change the new prompt into a forced value :"
..D ASK^PXRMDCPY(.ANS,TEXT,4,"N") Q:$D(DUOUT)!$D(DTOUT) Q:ANS'="Y"
..;Store the dialog type
..S DR="4///F",DIE=ROOT,DA=IENN
..D ^DIE
.S DTOUT=1,PXRMDANY=0
W !
;
I SKIP=1 W !,"The original "_WHAT_" "_ORGNAME_" has been copied into "_NAME_"." H 1 Q
;Tell the user what has happened and allow for editing of the new item.
S DIR(0)="Y"
S DIR("A")="Do you want to edit it now"
S DIR("A",1)="The original "_WHAT_" "_ORGNAME_" has been copied into "_NAME_"."
D ^DIR Q:$D(DIRUT)
I Y D EDIT^PXRMEDIT(ROOT,IENN)
Q
;
;=====================================================
COPYLL ;Copy a location list.
N PROMPT,ROOT,WHAT
S WHAT="location list"
S ROOT="^PXRMD(810.9,"
S PROMPT="Select the reminder location list to copy: "
D COPY(PROMPT,ROOT,WHAT)
Q
;
;=====================================================
COPYREM ;Copy a reminder definition.
N PROMPT,ROOT,WHAT
S WHAT="reminder"
S ROOT="^PXD(811.9,"
S PROMPT="Select the reminder definition to copy: "
D COPY(PROMPT,ROOT,WHAT)
Q
;
;=====================================================
COPYTAX ;Copy a taxonomy.
N PROMPT,ROOT,WHAT
S WHAT="taxonomy"
S ROOT="^PXD(811.2,"
S PROMPT="Select the reminder taxonomy to copy: "
D COPY(PROMPT,ROOT,WHAT)
Q
;
;=====================================================
COPYTERM ;Copy a reminder term.
N PROMPT,ROOT,WHAT
S WHAT="reminder term"
S ROOT="^PXRMD(811.5,"
S PROMPT="Select the reminder term to copy: "
D COPY(PROMPT,ROOT,WHAT)
Q
;
;=====================================================
DELETE(DIK,DA) ;Delete the entry just added.
D ^DIK
W !!,"New entry not created due to invalid name!",!
Q
;
;=====================================================
GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
;after a call to SETSTART.
N ENTRY,NIEN,OIEN
S ENTRY=ROOT_0_")"
S OIEN=+$P(@ENTRY,U,3)
S ENTRY=ROOT_OIEN_")"
F S NIEN=$O(@ENTRY) Q:+(NIEN-OIEN)>1 Q:+NIEN'>0 S OIEN=NIEN,ENTRY=ROOT_NIEN_")"
Q OIEN+1
;
;
HASGF(IEN) ;
N ARRAY,CNT,DIEN,DARRAY,RESULT
S CNT=0,RESULT=0
I $G(PXRMINST)=1 Q RESULT
S RESULT=$$ITEMHSGF(IEN) I RESULT=1 Q RESULT
I '$D(^PXRMD(801.41,IEN,10)) Q RESULT
D DITEMAR^PXRMDUTL(IEN,.ARRAY,.DARRAY,.CNT)
S DIEN=0 F S DIEN=$O(DARRAY(DIEN)) Q:DIEN'>0!(RESULT=1) D
.S RESULT=$$ITEMHSGF(DIEN)
Q RESULT
;
GFCANCPY(FIND) ;
N NAME,RESULT
S RESULT=1
S NAME=$P($G(^PXRMD(801.46,FIND,0)),U)
I NAME'="VIEW PROGRESS NOTE TEXT",$P(NAME," ")'="TICKLER" S RESULT=0
Q RESULT
;
ITEMHSGF(IEN) ;
N FIND,RESULT
S RESULT=0
I $G(PXRMINST)=1 Q RESULT
S FIND=$P($G(^PXRMD(801.41,IEN,1)),U,5)
I FIND[801.46,'$$GFCANCPY(+FIND) Q 1
S FOUND=0,FIND="" F S FIND=$O(^PXRMD(801.41,IEN,3,"B",FIND)) Q:FIND=""!(RESULT=1) D
.I FIND[801.46,'$$GFCANCPY(+FIND) S RESULT=1
Q RESULT
;
;=====================================================
INIEH(FILENUM,ROOT,IENN,IENO) ;Initialize the edit history after a copy.
;First delete any existing history entries.
N ENTRY,IND,IENS,FDA,FDAIEN,MSG,SFN,TARGET,WP
D FIELD^DID(FILENUM,"EDIT HISTORY","","SPECIFIER","TARGET")
S SFN=+$G(TARGET("SPECIFIER"))
I SFN=0 Q
S ENTRY=ROOT_IENN_",110)"
S IND=0
F S IND=$O(@ENTRY@(IND)) Q:+IND=0 D
. S IENS=IND_","_IENN_","
. S FDA(SFN,IENS,.01)="@"
I $D(FDA(SFN)) D FILE^DIE("K","FDA","MSG")
I $D(MSG) D AWRITE^PXRMUTIL("MSG")
;Establish an initial entry in the edit history.
K FDA,MSG
S IENS="+1,"_IENN_","
S FDAIEN(IENN)=IENN
S FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
S FDA(SFN,IENS,2)="WP(1,1)"
S WP(1,1,1)="Copied from "_$$GET1^DIQ(FILENUM,IENO,.01)
D UPDATE^DIE("E","FDA","FDAIEN","MSG")
I $D(MSG) D AWRITE^PXRMUTIL("MSG")
Q
;
;=====================================================
MERGE(IENN,IENO,ROOT) ;Use MERGE to copy ROOT(IENO into ROOT(IENN.
N DEST,SOURCE
S DEST=ROOT_IENN_")"
;Lock the file before merging.
L +@DEST:DILOCKTM
S SOURCE=ROOT_IENO_")"
M @DEST=@SOURCE
;Unlock the file
L -@DEST
Q
;
;=====================================================
SCAS(FILENUM,IEN,CLASS,SPONSOR) ;Set the class field to CLASS and the sponsor
;field to SPONSOR.
N IENS,FDA,MSG
S IENS=IEN_","
S FDA(FILENUM,IENS,100)=CLASS
S FDA(FILENUM,IENS,101)=SPONSOR
D FILE^DIE("K","FDA","MSG")
I $D(MSG) D AWRITE^PXRMUTIL("MSG")
Q
;
;=====================================================
SETSTART(ROOT) ;Set the starting value to add new entries. Start
;at the begining so empty spaces are filled in.
N CUR,ENTRY
S ENTRY=ROOT_"0)"
S $P(@ENTRY,U,3)=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCOPY 7318 printed Dec 13, 2024@01:43:17 Page 2
PXRMCOPY ;SLC/PKR,PJH - Copy various reminder files. ;Jun 29, 2021@11:59:53
+1 ;;2.0;CLINICAL REMINDERS;**6,12,26,45,71**;Feb 04, 2005;Build 43
+2 ;
+3 ;=====================================================
COPY(PROMPT,ROOT,WHAT) ;Copy an entry of ROOT into a new entry.
+1 NEW DIROUT,DTOUT,DUOUT
+2 FOR
DO GETORGR
if $DATA(DIROUT)
QUIT
if $DATA(DTOUT)
QUIT
+3 QUIT
+4 ;
+5 ;=====================================================
GETORGR ;Look-up logic to get and copy source entry to destination.
+1 NEW DIC,IENN,IENO,Y
+2 SET DIC=ROOT
SET DIC(0)="AEMQ"
SET DIC("A")=PROMPT
+3 WRITE !
+4 DO ^DIC
+5 IF $DATA(DUOUT)!$DATA(DTOUT)
SET DIROUT=""
QUIT
+6 SET IENO=$PIECE(Y,U,1)
+7 IF IENO=-1
SET DIROUT=""
QUIT
+8 DO GETORGRC(IENO,.IENN,ROOT,WHAT,0)
+9 QUIT
+10 ;
GETORGRC(IENO,IENN,ROOT,WHAT,SKIP) ;
+1 NEW DA,DIC,DIE,DIK,DIR,DIRUT,FAIL,FDA,FIELDLEN,FILE
+2 NEW HASGF,IENS,MSG,NAME,ORGNAME,X,Y
+3 ; reminder dialog checks
+4 SET DIC=ROOT
SET FAIL=0
+5 NEW DTYP,LFIND,LOCK
+6 IF ROOT="^PXRMD(801.41,"
Begin DoDot:1
+7 ;Check for Uneditable flag
+8 SET LOCK=$PIECE($GET(^PXRMD(801.41,IENO,100)),U,4)
+9 SET LFIND=$PIECE($GET(^PXRMD(801.41,IENO,1)),U,5)
+10 SET DTYP=$PIECE($GET(^PXRMD(801.41,IENO,0)),U,4)
+11 SET HASGF=$$HASGF(IENO)
+12 IF HASGF
Begin DoDot:2
+13 IF $PIECE($GET(^PXRMD(801.41,IENO,0)),U)="VA-TICKLER ELEMENT"
QUIT
+14 WRITE !,"This item cannot be copied."
SET FAIL=1
HANG 2
QUIT
End DoDot:2
+15 IF LOCK=1
IF '$GET(PXRMINST)
IF DTYP="G"
Begin DoDot:2
+16 WRITE !,"This item cannot be copied."
SET FAIL=1
HANG 2
End DoDot:2
QUIT
+17 IF LOCK=1
IF $GET(LFIND)'=""
IF $GET(LFIND)'["ORD"
IF '$GET(PXRMINST)
IF DTYP'="G"
Begin DoDot:2
+18 WRITE !,"This item cannot be copied."
SET FAIL=1
HANG 2
End DoDot:2
QUIT
End DoDot:1
+19 ;
+20 IF FAIL=1
QUIT
+21 ;Set the starting place for additions.
+22 DO SETSTART^PXRMCOPY(DIC)
+23 SET IENN=$$GETFOIEN(ROOT)
+24 DO MERGE(IENN,IENO,ROOT)
+25 ;
+26 ;Get the new name.
+27 SET ORGNAME=$PIECE(@(ROOT_IENO_",0)"),U,1)
+28 SET FILE=$$FNFR^PXRMUTIL(ROOT)
+29 SET FIELDLEN=$$GET1^DID(FILE,.01,"","FIELD LENGTH")
+30 SET DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
+31 SET DIR("A")="PLEASE ENTER A UNIQUE NAME"
GETNAM DO ^DIR
+1 IF $DATA(DIRUT)
DO DELETE(ROOT,IENN)
QUIT
+2 SET NAME=Y
+3 ;
+4 ;Make sure the new name is valid.
+5 IF '$$VNAME^PXRMINTR(NAME)
GOTO GETNAM
+6 ;
+7 ;Change to the new name.
+8 SET IENS=IENN_","
+9 SET FDA(FILE,IENS,.01)=NAME
+10 KILL MSG
+11 DO FILE^DIE("","FDA","MSG")
+12 ;Check to make sure the name was not a duplicate.
+13 IF $GET(MSG("DIERR",1))=740
Begin DoDot:1
+14 WRITE !,NAME," is not a unique name!"
End DoDot:1
GOTO GETNAM
+15 ;Change the class to local and delete the sponsor.
+16 DO SCAS(FILE,IENN,"L","")
+17 ;Initialize the edit history.
+18 DO INIEH(FILE,ROOT,IENN,IENO)
+19 ;
+20 ;Reindex the cross-references.
+21 SET DIK=ROOT
SET DA=IENN
+22 DO IX^DIK
+23 IF $GET(PXRMDANY)=1
Begin DoDot:1
+24 WRITE !!,"Completed copy of '"_ORGNAME_"'"
+25 WRITE !,"into '"_NAME_"'",!
HANG 2
+26 IF $PIECE(@(ROOT_IENN_",0)"),U,4)="P"
Begin DoDot:2
+27 ;Allow PXRM prompts to be changed into forced values
+28 NEW ANS,TEXT
+29 SET TEXT="Change the new prompt into a forced value :"
+30 DO ASK^PXRMDCPY(.ANS,TEXT,4,"N")
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
if ANS'="Y"
QUIT
+31 ;Store the dialog type
+32 SET DR="4///F"
SET DIE=ROOT
SET DA=IENN
+33 DO ^DIE
End DoDot:2
+34 SET DTOUT=1
SET PXRMDANY=0
End DoDot:1
QUIT
+35 WRITE !
+36 ;
+37 IF SKIP=1
WRITE !,"The original "_WHAT_" "_ORGNAME_" has been copied into "_NAME_"."
HANG 1
QUIT
+38 ;Tell the user what has happened and allow for editing of the new item.
+39 SET DIR(0)="Y"
+40 SET DIR("A")="Do you want to edit it now"
+41 SET DIR("A",1)="The original "_WHAT_" "_ORGNAME_" has been copied into "_NAME_"."
+42 DO ^DIR
if $DATA(DIRUT)
QUIT
+43 IF Y
DO EDIT^PXRMEDIT(ROOT,IENN)
+44 QUIT
+45 ;
+46 ;=====================================================
COPYLL ;Copy a location list.
+1 NEW PROMPT,ROOT,WHAT
+2 SET WHAT="location list"
+3 SET ROOT="^PXRMD(810.9,"
+4 SET PROMPT="Select the reminder location list to copy: "
+5 DO COPY(PROMPT,ROOT,WHAT)
+6 QUIT
+7 ;
+8 ;=====================================================
COPYREM ;Copy a reminder definition.
+1 NEW PROMPT,ROOT,WHAT
+2 SET WHAT="reminder"
+3 SET ROOT="^PXD(811.9,"
+4 SET PROMPT="Select the reminder definition to copy: "
+5 DO COPY(PROMPT,ROOT,WHAT)
+6 QUIT
+7 ;
+8 ;=====================================================
COPYTAX ;Copy a taxonomy.
+1 NEW PROMPT,ROOT,WHAT
+2 SET WHAT="taxonomy"
+3 SET ROOT="^PXD(811.2,"
+4 SET PROMPT="Select the reminder taxonomy to copy: "
+5 DO COPY(PROMPT,ROOT,WHAT)
+6 QUIT
+7 ;
+8 ;=====================================================
COPYTERM ;Copy a reminder term.
+1 NEW PROMPT,ROOT,WHAT
+2 SET WHAT="reminder term"
+3 SET ROOT="^PXRMD(811.5,"
+4 SET PROMPT="Select the reminder term to copy: "
+5 DO COPY(PROMPT,ROOT,WHAT)
+6 QUIT
+7 ;
+8 ;=====================================================
DELETE(DIK,DA) ;Delete the entry just added.
+1 DO ^DIK
+2 WRITE !!,"New entry not created due to invalid name!",!
+3 QUIT
+4 ;
+5 ;=====================================================
GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
+1 ;after a call to SETSTART.
+2 NEW ENTRY,NIEN,OIEN
+3 SET ENTRY=ROOT_0_")"
+4 SET OIEN=+$PIECE(@ENTRY,U,3)
+5 SET ENTRY=ROOT_OIEN_")"
+6 FOR
SET NIEN=$ORDER(@ENTRY)
if +(NIEN-OIEN)>1
QUIT
if +NIEN'>0
QUIT
SET OIEN=NIEN
SET ENTRY=ROOT_NIEN_")"
+7 QUIT OIEN+1
+8 ;
+9 ;
HASGF(IEN) ;
+1 NEW ARRAY,CNT,DIEN,DARRAY,RESULT
+2 SET CNT=0
SET RESULT=0
+3 IF $GET(PXRMINST)=1
QUIT RESULT
+4 SET RESULT=$$ITEMHSGF(IEN)
IF RESULT=1
QUIT RESULT
+5 IF '$DATA(^PXRMD(801.41,IEN,10))
QUIT RESULT
+6 DO DITEMAR^PXRMDUTL(IEN,.ARRAY,.DARRAY,.CNT)
+7 SET DIEN=0
FOR
SET DIEN=$ORDER(DARRAY(DIEN))
if DIEN'>0!(RESULT=1)
QUIT
Begin DoDot:1
+8 SET RESULT=$$ITEMHSGF(DIEN)
End DoDot:1
+9 QUIT RESULT
+10 ;
GFCANCPY(FIND) ;
+1 NEW NAME,RESULT
+2 SET RESULT=1
+3 SET NAME=$PIECE($GET(^PXRMD(801.46,FIND,0)),U)
+4 IF NAME'="VIEW PROGRESS NOTE TEXT"
IF $PIECE(NAME," ")'="TICKLER"
SET RESULT=0
+5 QUIT RESULT
+6 ;
ITEMHSGF(IEN) ;
+1 NEW FIND,RESULT
+2 SET RESULT=0
+3 IF $GET(PXRMINST)=1
QUIT RESULT
+4 SET FIND=$PIECE($GET(^PXRMD(801.41,IEN,1)),U,5)
+5 IF FIND[801.46
IF '$$GFCANCPY(+FIND)
QUIT 1
+6 SET FOUND=0
SET FIND=""
FOR
SET FIND=$ORDER(^PXRMD(801.41,IEN,3,"B",FIND))
if FIND=""!(RESULT=1)
QUIT
Begin DoDot:1
+7 IF FIND[801.46
IF '$$GFCANCPY(+FIND)
SET RESULT=1
End DoDot:1
+8 QUIT RESULT
+9 ;
+10 ;=====================================================
INIEH(FILENUM,ROOT,IENN,IENO) ;Initialize the edit history after a copy.
+1 ;First delete any existing history entries.
+2 NEW ENTRY,IND,IENS,FDA,FDAIEN,MSG,SFN,TARGET,WP
+3 DO FIELD^DID(FILENUM,"EDIT HISTORY","","SPECIFIER","TARGET")
+4 SET SFN=+$GET(TARGET("SPECIFIER"))
+5 IF SFN=0
QUIT
+6 SET ENTRY=ROOT_IENN_",110)"
+7 SET IND=0
+8 FOR
SET IND=$ORDER(@ENTRY@(IND))
if +IND=0
QUIT
Begin DoDot:1
+9 SET IENS=IND_","_IENN_","
+10 SET FDA(SFN,IENS,.01)="@"
End DoDot:1
+11 IF $DATA(FDA(SFN))
DO FILE^DIE("K","FDA","MSG")
+12 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
+13 ;Establish an initial entry in the edit history.
+14 KILL FDA,MSG
+15 SET IENS="+1,"_IENN_","
+16 SET FDAIEN(IENN)=IENN
+17 SET FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+18 SET FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
+19 SET FDA(SFN,IENS,2)="WP(1,1)"
+20 SET WP(1,1,1)="Copied from "_$$GET1^DIQ(FILENUM,IENO,.01)
+21 DO UPDATE^DIE("E","FDA","FDAIEN","MSG")
+22 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
+23 QUIT
+24 ;
+25 ;=====================================================
MERGE(IENN,IENO,ROOT) ;Use MERGE to copy ROOT(IENO into ROOT(IENN.
+1 NEW DEST,SOURCE
+2 SET DEST=ROOT_IENN_")"
+3 ;Lock the file before merging.
+4 LOCK +@DEST:DILOCKTM
+5 SET SOURCE=ROOT_IENO_")"
+6 MERGE @DEST=@SOURCE
+7 ;Unlock the file
+8 LOCK -@DEST
+9 QUIT
+10 ;
+11 ;=====================================================
SCAS(FILENUM,IEN,CLASS,SPONSOR) ;Set the class field to CLASS and the sponsor
+1 ;field to SPONSOR.
+2 NEW IENS,FDA,MSG
+3 SET IENS=IEN_","
+4 SET FDA(FILENUM,IENS,100)=CLASS
+5 SET FDA(FILENUM,IENS,101)=SPONSOR
+6 DO FILE^DIE("K","FDA","MSG")
+7 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
+8 QUIT
+9 ;
+10 ;=====================================================
SETSTART(ROOT) ;Set the starting value to add new entries. Start
+1 ;at the begining so empty spaces are filled in.
+2 NEW CUR,ENTRY
+3 SET ENTRY=ROOT_"0)"
+4 SET $PIECE(@ENTRY,U,3)=1
+5 QUIT
+6 ;
