Routine: PXRMREDT

PXRMREDT ;SLC/PKR,PJH - Edit PXRM reminder definition. ;01/30/2013

 ;;2.0;CLINICAL REMINDERS;**4,6,12,18,26**;Feb 04, 2005;Build 404

 ;=======================================================

EEDIT ;Entry point for PXRM DEFINITION EDIT option.

 ;Build list of finding file definitions.

 N DEF,DEF1,DEF2,NEW

 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 N DA,DIC,DLAYGO,DTOUT,DUOUT,Y

 S DIC="^PXD(811.9,"

 S DIC(0)="AEMQL"

 S DIC("A")="Select Reminder Definition: "

 S DLAYGO=811.9

GETNAME ;Get the name of the reminder definition to edit.

 ;Set the starting place for additions.

 D SETSTART^PXRMCOPY(DIC)

W !

 S DIC("W")="W $$LUDISP^PXRMREDT(Y)"

 D ^DIC

 I ($D(DTOUT))!($D(DUOUT)) Q

 I Y=-1 G END

 S DA=$P(Y,U,1)

 S NEW=$P(Y,U,3)

 D ALL(DIC,DA,.DEF1,NEW)

 G GETNAME

END ;

 ;=======================================================

 ;Select section of reminder to edit, also called at ALL by PXRMEDIT.

 ;----------------------------------

ALL(DIC,DA,DEF1,NEW) ;

 ;Get list of findings/terms for reminder

 N BLDLOGIC,CS1,CS2,DTOUT,DUOUT,LIST,NODE,OPTION,TYPE

 ;Save the original checksum.

 S CS1=$$FILE^PXRMEXCS(811.9,DA)

STRTEDIT S BLDLOGIC=0

 ;Build finding list

 S NODE="^PXD(811.9)"

 D LIST(NODE,DA,.DEF1,.LIST)

 ;If this is a new reminder enter all fields

 I $G(NEW) D EDIT(DIC,DA) Q

 ;National reminder allows editing of term findings only

 I '$$VEDIT^PXRMUTIL(DIC,DA) D  Q:$D(DUOUT)!$D(DTOUT)

 .S TYPE=""

 .F  S TYPE=$O(LIST(TYPE)) Q:TYPE=""  D

 .. I TYPE="RT" Q

 .. K LIST(TYPE)

 .I '$D(LIST) S DUOUT=1 Q

 .S BLDLOGIC=1

 .D TFIND(DA,.LIST)

 .I $D(Y) S DUOUT=1

 ;Otherwise choose fields to edit

 I $$VEDIT^PXRMUTIL(DIC,DA) F  D  Q:($G(OPTION)="^")!$D(DUOUT)!$D(DTOUT)

 .S OPTION=$$OPTION^PXRMREDT Q:(OPTION="^")!$D(DUOUT)!$D(DTOUT)

 .;All details

 .I OPTION="A" D

 .. S BLDLOGIC=1

 .. D EDIT(DIC,DA)

 .;Set up local variables

 .N DIE,DR S DIE=DIC N DIC

 .;Descriptions

 .I OPTION="G" D

 ..D GEN

 .;Baseline Frequency

 .I OPTION="B" D

 ..S BLDLOGIC=1

 ..D BASE

 .;Findings

 .I OPTION="F"  D

 ..S BLDLOGIC=1

 ..D FIND(.LIST)

 .;Function findings

 .I OPTION="FF"  D

 ..S BLDLOGIC=1

 ..D FFIND

 .;Logic

 .I OPTION="L" D

 ..S BLDLOGIC=1

 ..D LOGIC

 .;Custom date due

 . I OPTION="C" D

 ..S BLDLOGIC=1

 ..D CDUE

 .;Dialog

 .I OPTION="D" D

 ..D DIALOG

 .;Web addresses

 .I OPTION="W" D

 ..D WEB

 .;If necessary build the internal logic strings.

 .I BLDLOGIC D BLDALL^PXRMLOGX(DA,"","")

 ;See if any changes have been made.

 S CS2=$$FILE^PXRMEXCS(811.9,DA)

 I CS2=0 Q

 ;If the file has been edited, do an integrity check.

 I CS2'=CS1 D

 . ;I OPTION="^" Q

 . W !,"Checking integrity of the definition ...",#

 . I OPTION'="^",'$$DEF^PXRMICHK(DA) G STRTEDIT

 .;If it passes the integrity check save the edit history.

 . D SEHIST^PXRMUTIL(811.9,DIC,DA)

 ;Reminder Edit

 ;-------------

EDIT(ROOT,DA) ;

 N DIC,DIDEL,DIE,DR,RESULT

 S DIE=ROOT,DIDEL=811.9

 ;Edit the fields in the same order they are printed by a reminder

 ;inquiry.

 ;Reminder name

 W !!

 S DR=".01"

 D ^DIE

 ;If DA is undefined then the entry was deleted and we are done.

 I '$D(DA) S DTOUT=1 Q

 I $D(Y) S DTOUT=1 Q

 ;Other fields

 D GEN Q:$D(Y)

 D BASE Q:$D(Y)

 D FIND(.LIST) Q:$D(Y)

 D FFIND Q:$D(Y)

 D LOGIC Q:$D(Y)

 D DIALOG Q:$D(Y)

 D WEB Q:$D(Y)

W #

 I '$$DEF^PXRMICHK(DA) G STRTEDIT

 ;If it passes the integrity check save the edit history.

 D SEHIST^PXRMUTIL(811.9,DIC,DA)

GEN ;Print name

 W !!

 S DR="1.2"

 D ^DIE

 I $D(Y) Q

CLASS ;

 ;Class

 W !!

 S DR="100"

 D ^DIE

 I $D(Y) Q

 ;Sponsor

 S DR="101"

 D ^DIE

 I $D(Y) Q

 ;Make sure Class and Sponsor Class are in synch.

 S RESULT=$$VSPONSOR^PXRMINTR(X)

 I RESULT=0 G CLASS

 ;Review date, Usage

 S DR="102;103"

 D ^DIE

 I $D(Y) Q

 ;Related VA-* reminder

 W !!

 S DR="1.4"

 D ^DIE

 I $D(Y) Q

 ;Inactive flag

 W !!

 S DR="1.6"

 D ^DIE

 I $D(Y) Q

 ;Ignore on N/A

 S DR=1.8

 D ^DIE

 I $D(Y) Q

 ;Recision Date

 S DR="69"

 D ^DIE

 I $D(Y) Q

 ;Reminder description

 W !!

 S DR="2"

 D ^DIE

 I $D(Y) Q

 ;Technical description

 W !!

 S DR="3"

 D ^DIE

 ;Priority

 W !!

 S DR="1.91"

 D ^DIE

BASE W !!,"Baseline Frequency"

 ;Do in advance time frame

 S DR=1.3

 D ^DIE

 I $D(Y) Q

 ;Sex specific

 S DR=1.9

 D ^DIE

 I $D(Y) Q

FARS ;

 W !!,"Baseline frequency age range set"

 S DR="7"

 S DR(2,811.97)=".01;1;2;3;4"

 D ^DIE

 I $$OVLAP^PXRMAGE G FARS

 D SNMLA^PXRMFNFT(DA)

FIND(LIST) ;Edit findings (multiple)

 D FIND^PXRMREDF(.LIST)

 D SNMLF^PXRMFNFT(DA,20)

FFIND W !!,"Function Findings"

 D FFIND^PXRMREDF

 D SNMLF^PXRMFNFT(DA,25)

LOGIC W !!,"Patient Cohort and Resolution Logic"

 S DR="30T;60T;61T;70T;71T;34T;65T;66T;75T;76T"

 D ^DIE

 ;Make sure the Patient Cohort Logic at least contains the default.

 I $G(^PXD(811.9,DA,31))="" D

 . S ^PXD(811.9,DA,31)="(SEX)&(AGE)"

 . S ^PXD(811.9,DA,32)="2"_U_"SEX;AGE"

 D SNMLL^PXRMFNFT(DA)

CDUE W !!,"Custom Date Due"

 S DR=45

 D ^DIE

DIALOG W !!,"Reminder Dialog"

 S DR="51"

 D ^DIE

WEB W !!,"Web Addresses for Reminder Information"

 S DR="50"

 D ^DIE

 ;Get full list of findings

 ;-------------------------

LIST(GBL,DA,DEF1,ARRAY) ;

 N CNT,DATA,GLOB,IEN,NAME,NODE,SUB,TYPE

 ;Clear passed arrays

 K ARRAY

 S CNT=0

 ;Build cross reference global to file number

 ;Get each finding

 S SUB=0 F  S SUB=$O(@GBL@(DA,20,SUB)) Q:'SUB  D

 .S DATA=$G(@GBL@(DA,20,SUB,0)) I DATA="" Q

 .;Determine global and global ien

 .S NODE=$P(DATA,U),GLOB=$P(NODE,";",2),IEN=$P(NODE,";")

 .;Ignore null entries

 .I (GLOB="")!(IEN="") Q

 .;Work out the file type

 .S TYPE=$G(DEF1(GLOB)) Q:TYPE=""

 .S CNT=CNT+1

 .I $P($G(@(U_GLOB_IEN_",0)")),U)="" D

 ..W !,"**WARNING** Finding #"_SUB_" does not exist, select finding `"_SUB_" to edit it." Q

 .E  S NAME=$P($G(@(U_GLOB_IEN_",0)")),U) S ARRAY(TYPE,NAME,SUB)=IEN

 ;Choose which part of Reminder to edit

 ;-------------------------------------

OPTION() ;

 N DIR,X,Y

 ;Display warning message if un-mapped terms exist

 K DIROUT,DIRUT

 S DIR(0)="SO"_U

 S DIR(0)=DIR(0)_"A:All reminder details;"

 S DIR(0)=DIR(0)_"G:General;"

 S DIR(0)=DIR(0)_"B:Baseline Frequency;"

 S DIR(0)=DIR(0)_"F:Findings;"

 S DIR(0)=DIR(0)_"FF:Function Findings;"

 S DIR(0)=DIR(0)_"L:Logic;"

 S DIR(0)=DIR(0)_"C:Custom date due;"

 S DIR(0)=DIR(0)_"D:Reminder Dialog;"

 S DIR(0)=DIR(0)_"W:Web Addresses;"

 S DIR("A",1)="Select a section to edit; press ENTER when you are done editing."

 S DIR("A")="To quit and exit type '^'"

 S DIR("?")="Select which section of the reminder you wish to edit."

 S DIR("??")="^D HELP^PXRMREDF(2)"

 D ^DIR K DIR

 I (Y="")!(Y="^") S DUOUT=1

Q Y

 ;-------------------------------------

LUDISP(IEN) ;Use for DIC("W") to augment look-up display.

 N CLASS,EM,INACTIVE,TEXT

 S INACTIVE=$P(^PXD(811.9,IEN,0),U,6)

 S CLASS=$P(^PXD(811.9,IEN,100),U,1)

 I INACTIVE'="" S INACTIVE="("_$$EXTERNAL^DILFD(811.9,1.6,"",INACTIVE,.EM)_")"

 S CLASS=$$EXTERNAL^DILFD(811.9,100,"",CLASS,.EM)

 S TEXT="  "_CLASS_" "_INACTIVE

 Q TEXT

 ;-------------------------------------

TFIND(DA,LIST) ;Allow edit of term findings for national reminders.

 N DIR,IENLIST,IND,JND,NAME,NAMELIST,SUB,X,Y

 S IND=0,NAME=""

 F  S NAME=$O(LIST("RT",NAME)) Q:NAME=""  D

 . S IND=IND+1

 . S NAMELIST(IND)=$$RJ^XLFSTR(IND,3)_" "_NAME

 . S SUB=$O(LIST("RT",NAME,""))

 . S IENLIST(IND)=LIST("RT",NAME,SUB)

 M DIR("A")=NAMELIST

 S DIR("A")="Enter your list"

 S DIR(0)="LO^1:"_IND

 W !!,"Select term(s) for finding edit:"

 D ^DIR

 I $D(DIROUT)!$D(DIRUT) S LIST="" Q

 I $D(DUOUT)!$D(DTOUT) S LIST="" Q

 F IND=1:1:$L(Y,",")-1 D

 . S JND=$P(Y,",",IND)

 . S NAME=$P(NAMELIST(JND),JND,2)

 . W !!,"Reminder Term:",NAME

 . D TMAP^PXRMREDF(DA,IENLIST(JND))

PXRMREDT  ;SLC/PKR,PJH - Edit PXRM reminder definition. ;01/30/2013

 +1       ;;2.0;CLINICAL REMINDERS;**4,6,12,18,26**;Feb 04, 2005;Build 404

 +2       ;

 +3       ;=======================================================

EEDIT     ;Entry point for PXRM DEFINITION EDIT option.

 +1       ;Build list of finding file definitions.

 +2        NEW DEF,DEF1,DEF2,NEW

 +3        DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 +4       ;

 +5        NEW DA,DIC,DLAYGO,DTOUT,DUOUT,Y

 +6        SET DIC="^PXD(811.9,"

 +7        SET DIC(0)="AEMQL"

 +8        SET DIC("A")="Select Reminder Definition: "

 +9        SET DLAYGO=811.9

GETNAME   ;Get the name of the reminder definition to edit.

 +1       ;Set the starting place for additions.

 +2        DO SETSTART^PXRMCOPY(DIC)

 +3        WRITE !

 +4        SET DIC("W")="W $$LUDISP^PXRMREDT(Y)"

 +5        DO ^DIC

 +6        IF ($DATA(DTOUT))!($DATA(DUOUT))

               QUIT

 +7        IF Y=-1

               GOTO END

 +8        SET DA=$PIECE(Y,U,1)

 +9        SET NEW=$PIECE(Y,U,3)

 +10       DO ALL(DIC,DA,.DEF1,NEW)

 +11       GOTO GETNAME

END       ;

 +1        QUIT

 +2       ;

 +3       ;=======================================================

 +4       ;Select section of reminder to edit, also called at ALL by PXRMEDIT.

 +5       ;----------------------------------

ALL(DIC,DA,DEF1,NEW) ;

 +1       ;Get list of findings/terms for reminder

 +2        NEW BLDLOGIC,CS1,CS2,DTOUT,DUOUT,LIST,NODE,OPTION,TYPE

 +3       ;Save the original checksum.

 +4        SET CS1=$$FILE^PXRMEXCS(811.9,DA)

STRTEDIT   SET BLDLOGIC=0

 +1       ;Build finding list

 +2        SET NODE="^PXD(811.9)"

 +3        DO LIST(NODE,DA,.DEF1,.LIST)

 +4       ;If this is a new reminder enter all fields

 +5        IF $GET(NEW)

               DO EDIT(DIC,DA)

               QUIT

 +6       ;National reminder allows editing of term findings only

 +7        IF '$$VEDIT^PXRMUTIL(DIC,DA)

               Begin DoDot:1

 +8                SET TYPE=""

 +9                FOR

                       SET TYPE=$ORDER(LIST(TYPE))

                       IF TYPE=""

                           QUIT

                       Begin DoDot:2

 +10                       IF TYPE="RT"

                               QUIT

 +11                       KILL LIST(TYPE)

                       End DoDot:2

 +12               IF '$DATA(LIST)

                       SET DUOUT=1

                       QUIT

 +13               SET BLDLOGIC=1

 +14               DO TFIND(DA,.LIST)

 +15               IF $DATA(Y)

                       SET DUOUT=1

               End DoDot:1

               IF $DATA(DUOUT)!$DATA(DTOUT)

                   QUIT

 +16      ;Otherwise choose fields to edit

 +17       IF $$VEDIT^PXRMUTIL(DIC,DA)

FOR

                   Begin DoDot:1

 +18                   SET OPTION=$$OPTION^PXRMREDT

                       IF (OPTION="^")!$DATA(DUOUT)!$DATA(DTOUT)

                           QUIT

 +19      ;All details

 +20                   IF OPTION="A"

                           Begin DoDot:2

 +21                           SET BLDLOGIC=1

 +22                           DO EDIT(DIC,DA)

                           End DoDot:2

 +23      ;Set up local variables

 +24                   NEW DIE,DR

                       SET DIE=DIC

                       NEW DIC

 +25      ;Descriptions

 +26                   IF OPTION="G"

                           Begin DoDot:2

 +27                           DO GEN

                           End DoDot:2

 +28      ;Baseline Frequency

 +29                   IF OPTION="B"

                           Begin DoDot:2

 +30                           SET BLDLOGIC=1

 +31                           DO BASE

                           End DoDot:2

 +32      ;Findings

 +33                   IF OPTION="F"

                           Begin DoDot:2

 +34                           SET BLDLOGIC=1

 +35                           DO FIND(.LIST)

                           End DoDot:2

 +36      ;Function findings

 +37                   IF OPTION="FF"

                           Begin DoDot:2

 +38                           SET BLDLOGIC=1

 +39                           DO FFIND

                           End DoDot:2

 +40      ;Logic

 +41                   IF OPTION="L"

                           Begin DoDot:2

 +42                           SET BLDLOGIC=1

 +43                           DO LOGIC

                           End DoDot:2

 +44      ;Custom date due

 +45                   IF OPTION="C"

                           Begin DoDot:2

 +46                           SET BLDLOGIC=1

 +47                           DO CDUE

                           End DoDot:2

 +48      ;Dialog

 +49                   IF OPTION="D"

                           Begin DoDot:2

 +50                           DO DIALOG

                           End DoDot:2

 +51      ;Web addresses

 +52                   IF OPTION="W"

                           Begin DoDot:2

 +53                           DO WEB

                           End DoDot:2

 +54      ;If necessary build the internal logic strings.

 +55                   IF BLDLOGIC

                           DO BLDALL^PXRMLOGX(DA,"","")

                   End DoDot:1

                   IF ($GET(OPTION)="^")!$DATA(DUOUT)!$DATA(DTOUT)

                       QUIT

 +56      ;See if any changes have been made.

 +57       SET CS2=$$FILE^PXRMEXCS(811.9,DA)

 +58       IF CS2=0

               QUIT

 +59      ;If the file has been edited, do an integrity check.

 +60       IF CS2'=CS1

               Begin DoDot:1

 +61      ;I OPTION="^" Q

 +62               WRITE !,"Checking integrity of the definition ...",#

 +63               IF OPTION'="^"

                       IF '$$DEF^PXRMICHK(DA)

                           GOTO STRTEDIT

 +64      ;If it passes the integrity check save the edit history.

 +65               DO SEHIST^PXRMUTIL(811.9,DIC,DA)

               End DoDot:1

 +66       QUIT

 +67      ;

 +68      ;Reminder Edit

 +69      ;-------------

EDIT(ROOT,DA) ;

 +1        NEW DIC,DIDEL,DIE,DR,RESULT

 +2        SET DIE=ROOT

           SET DIDEL=811.9

 +3       ;Edit the fields in the same order they are printed by a reminder

 +4       ;inquiry.

 +5       ;Reminder name

 +6        WRITE !!

 +7        SET DR=".01"

 +8        DO ^DIE

 +9       ;If DA is undefined then the entry was deleted and we are done.

 +10       IF '$DATA(DA)

               SET DTOUT=1

               QUIT

 +11       IF $DATA(Y)

               SET DTOUT=1

               QUIT

 +12      ;

 +13      ;Other fields

 +14       DO GEN

           IF $DATA(Y)

               QUIT

 +15       DO BASE

           IF $DATA(Y)

               QUIT

 +16       DO FIND(.LIST)

           IF $DATA(Y)

               QUIT

 +17       DO FFIND

           IF $DATA(Y)

               QUIT

 +18       DO LOGIC

           IF $DATA(Y)

               QUIT

 +19       DO DIALOG

           IF $DATA(Y)

               QUIT

 +20       DO WEB

           IF $DATA(Y)

               QUIT

 +21       WRITE #

 +22       IF '$$DEF^PXRMICHK(DA)

               GOTO STRTEDIT

 +23      ;If it passes the integrity check save the edit history.

 +24       DO SEHIST^PXRMUTIL(811.9,DIC,DA)

 +25       QUIT

 +26      ;

GEN       ;Print name

 +1        WRITE !!

 +2        SET DR="1.2"

 +3        DO ^DIE

 +4        IF $DATA(Y)

               QUIT

 +5       ;

CLASS     ;

 +1       ;Class

 +2        WRITE !!

 +3        SET DR="100"

 +4        DO ^DIE

 +5        IF $DATA(Y)

               QUIT

 +6       ;Sponsor

 +7        SET DR="101"

 +8        DO ^DIE

 +9        IF $DATA(Y)

               QUIT

 +10      ;Make sure Class and Sponsor Class are in synch.

 +11       SET RESULT=$$VSPONSOR^PXRMINTR(X)

 +12       IF RESULT=0

               GOTO CLASS

 +13      ;Review date, Usage

 +14       SET DR="102;103"

 +15       DO ^DIE

 +16       IF $DATA(Y)

               QUIT

 +17      ;

 +18      ;Related VA-* reminder

 +19       WRITE !!

 +20       SET DR="1.4"

 +21       DO ^DIE

 +22       IF $DATA(Y)

               QUIT

 +23      ;

 +24      ;Inactive flag

 +25       WRITE !!

 +26       SET DR="1.6"

 +27       DO ^DIE

 +28       IF $DATA(Y)

               QUIT

 +29      ;Ignore on N/A

 +30       SET DR=1.8

 +31       DO ^DIE

 +32       IF $DATA(Y)

               QUIT

 +33      ;

 +34      ;Recision Date

 +35       SET DR="69"

 +36       DO ^DIE

 +37       IF $DATA(Y)

               QUIT

 +38      ;

 +39      ;Reminder description

 +40       WRITE !!

 +41       SET DR="2"

 +42       DO ^DIE

 +43       IF $DATA(Y)

               QUIT

 +44      ;

 +45      ;Technical description

 +46       WRITE !!

 +47       SET DR="3"

 +48       DO ^DIE

 +49      ;

 +50      ;Priority

 +51       WRITE !!

 +52       SET DR="1.91"

 +53       DO ^DIE

 +54       QUIT

 +55      ;

BASE       WRITE !!,"Baseline Frequency"

 +1       ;Do in advance time frame

 +2        SET DR=1.3

 +3        DO ^DIE

 +4        IF $DATA(Y)

               QUIT

 +5       ;

 +6       ;Sex specific

 +7        SET DR=1.9

 +8        DO ^DIE

 +9        IF $DATA(Y)

               QUIT

FARS      ;

 +1        WRITE !!,"Baseline frequency age range set"

 +2        SET DR="7"

 +3        SET DR(2,811.97)=".01;1;2;3;4"

 +4        DO ^DIE

 +5        IF $$OVLAP^PXRMAGE

               GOTO FARS

 +6        DO SNMLA^PXRMFNFT(DA)

 +7        QUIT

 +8       ;

FIND(LIST) ;Edit findings (multiple)

 +1        DO FIND^PXRMREDF(.LIST)

 +2        DO SNMLF^PXRMFNFT(DA,20)

 +3        QUIT

 +4       ;

FFIND      WRITE !!,"Function Findings"

 +1        DO FFIND^PXRMREDF

 +2        DO SNMLF^PXRMFNFT(DA,25)

 +3        QUIT

 +4       ;

LOGIC      WRITE !!,"Patient Cohort and Resolution Logic"

 +1        SET DR="30T;60T;61T;70T;71T;34T;65T;66T;75T;76T"

 +2        DO ^DIE

 +3       ;Make sure the Patient Cohort Logic at least contains the default.

 +4        IF $GET(^PXD(811.9,DA,31))=""

               Begin DoDot:1

 +5                SET ^PXD(811.9,DA,31)="(SEX)&(AGE)"

 +6                SET ^PXD(811.9,DA,32)="2"_U_"SEX;AGE"

               End DoDot:1

 +7        DO SNMLL^PXRMFNFT(DA)

 +8        QUIT

CDUE       WRITE !!,"Custom Date Due"

 +1        SET DR=45

 +2        DO ^DIE

 +3        QUIT

 +4       ;

DIALOG     WRITE !!,"Reminder Dialog"

 +1        SET DR="51"

 +2        DO ^DIE

 +3        QUIT

 +4       ;

WEB        WRITE !!,"Web Addresses for Reminder Information"

 +1        SET DR="50"

 +2        DO ^DIE

 +3        QUIT

 +4       ;

 +5       ;Get full list of findings

 +6       ;-------------------------

LIST(GBL,DA,DEF1,ARRAY) ;

 +1        NEW CNT,DATA,GLOB,IEN,NAME,NODE,SUB,TYPE

 +2       ;Clear passed arrays

 +3        KILL ARRAY

 +4        SET CNT=0

 +5       ;Build cross reference global to file number

 +6       ;Get each finding

 +7        SET SUB=0

FOR

               SET SUB=$ORDER(@GBL@(DA,20,SUB))

               IF 'SUB

                   QUIT

               Begin DoDot:1

 +8                SET DATA=$GET(@GBL@(DA,20,SUB,0))

                   IF DATA=""

                       QUIT

 +9       ;Determine global and global ien

 +10               SET NODE=$PIECE(DATA,U)

                   SET GLOB=$PIECE(NODE,";",2)

                   SET IEN=$PIECE(NODE,";")

 +11      ;Ignore null entries

 +12               IF (GLOB="")!(IEN="")

                       QUIT

 +13      ;Work out the file type

 +14               SET TYPE=$GET(DEF1(GLOB))

                   IF TYPE=""

                       QUIT

 +15               SET CNT=CNT+1

 +16               IF $PIECE($GET(@(U_GLOB_IEN_",0)")),U)=""

                       Begin DoDot:2

 +17                       WRITE !,"**WARNING** Finding #"_SUB_" does not exist, select finding `"_SUB_" to edit it."

                           QUIT

                       End DoDot:2

 +18              IF '$TEST

                       SET NAME=$PIECE($GET(@(U_GLOB_IEN_",0)")),U)

                       SET ARRAY(TYPE,NAME,SUB)=IEN

               End DoDot:1

 +19       QUIT

 +20      ;

 +21      ;Choose which part of Reminder to edit

 +22      ;-------------------------------------

OPTION()  ;

 +1        NEW DIR,X,Y

 +2       ;Display warning message if un-mapped terms exist

 +3        KILL DIROUT,DIRUT

 +4        SET DIR(0)="SO"_U

 +5        SET DIR(0)=DIR(0)_"A:All reminder details;"

 +6        SET DIR(0)=DIR(0)_"G:General;"

 +7        SET DIR(0)=DIR(0)_"B:Baseline Frequency;"

 +8        SET DIR(0)=DIR(0)_"F:Findings;"

 +9        SET DIR(0)=DIR(0)_"FF:Function Findings;"

 +10       SET DIR(0)=DIR(0)_"L:Logic;"

 +11       SET DIR(0)=DIR(0)_"C:Custom date due;"

 +12       SET DIR(0)=DIR(0)_"D:Reminder Dialog;"

 +13       SET DIR(0)=DIR(0)_"W:Web Addresses;"

 +14       SET DIR("A",1)="Select a section to edit; press ENTER when you are done editing."

 +15       SET DIR("A")="To quit and exit type '^'"

 +16       SET DIR("?")="Select which section of the reminder you wish to edit."

 +17       SET DIR("??")="^D HELP^PXRMREDF(2)"

 +18       DO ^DIR

           KILL DIR

 +19       IF (Y="")!(Y="^")

               SET DUOUT=1

 +20       QUIT Y

 +21      ;

 +22      ;-------------------------------------

LUDISP(IEN) ;Use for DIC("W") to augment look-up display.

 +1        NEW CLASS,EM,INACTIVE,TEXT

 +2        SET INACTIVE=$PIECE(^PXD(811.9,IEN,0),U,6)

 +3        SET CLASS=$PIECE(^PXD(811.9,IEN,100),U,1)

 +4        IF INACTIVE'=""

               SET INACTIVE="("_$$EXTERNAL^DILFD(811.9,1.6,"",INACTIVE,.EM)_")"

 +5        SET CLASS=$$EXTERNAL^DILFD(811.9,100,"",CLASS,.EM)

 +6        SET TEXT="  "_CLASS_" "_INACTIVE

 +7        QUIT TEXT

 +8       ;

 +9       ;-------------------------------------

TFIND(DA,LIST) ;Allow edit of term findings for national reminders.

 +1        NEW DIR,IENLIST,IND,JND,NAME,NAMELIST,SUB,X,Y

 +2        SET IND=0

           SET NAME=""

 +3        FOR

               SET NAME=$ORDER(LIST("RT",NAME))

               IF NAME=""

                   QUIT

               Begin DoDot:1

 +4                SET IND=IND+1

 +5                SET NAMELIST(IND)=$$RJ^XLFSTR(IND,3)_" "_NAME

 +6                SET SUB=$ORDER(LIST("RT",NAME,""))

 +7                SET IENLIST(IND)=LIST("RT",NAME,SUB)

               End DoDot:1

 +8        MERGE DIR("A")=NAMELIST

 +9        SET DIR("A")="Enter your list"

 +10       SET DIR(0)="LO^1:"_IND

 +11       WRITE !!,"Select term(s) for finding edit:"

 +12       DO ^DIR

 +13       IF $DATA(DIROUT)!$DATA(DIRUT)

               SET LIST=""

               QUIT

 +14       IF $DATA(DUOUT)!$DATA(DTOUT)

               SET LIST=""

               QUIT

 +15       FOR IND=1:1:$LENGTH(Y,",")-1

               Begin DoDot:1

 +16               SET JND=$PIECE(Y,",",IND)

 +17               SET NAME=$PIECE(NAMELIST(JND),JND,2)

 +18               WRITE !!,"Reminder Term:",NAME

 +19               DO TMAP^PXRMREDF(DA,IENLIST(JND))

               End DoDot:1

 +20       QUIT

 +21      ;

PXRMREDT.m