PXRMDEDX.m

PXRMDEDX ;SLC/PJH - Delete dialog components ;12/12/2001

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

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

 ;

 ;Yes/No Prompts

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

ASK(YESNO,TEXT,HELP) ;

 W !

 N DIR,X,Y

 K DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="YA0"

 M DIR("A")=TEXT

 S DIR("B")="Y"

 S DIR("?")="Enter Y or N. For detailed help type ??"

 S DIR("??")=U_"D HLP^PXRMDEDX(HELP)"

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

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

 S YESNO=$E(Y(0))

 Q

 ;

 ;Give option to delete all descendents

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

DELETE(COMP) ;

 N ANS,HLP,DIEN,DNAM,DTYP,IC,TEXT

 ;Parent name and type

 S DNAM=$P(COMP(0),U),DTYP=$P(COMP(0),U,2)

 ;Prompt information

 I DTYP="R" D

 .S TEXT(1)="Reminder dialog "_DNAM_" had unused components."

 .S TEXT="Delete all these components:"

 I DTYP="G" D

 .S TEXT(1)="Dialog group "_DNAM_" had unused elements or prompts."

 .S TEXT="Delete all these components:"

 I DTYP="E" D

 .S TEXT(1)="Deleted dialog element "_DNAM_" had unused prompts."

 .S TEXT="Delete all these components:"

 ;List component names

 S IC=2,DIEN=0,TEXT(2)="",HLP=1

 F  S DIEN=$O(COMP(DIEN)) Q:'DIEN  D  Q:IC>15

 .S IC=IC+1 I IC>15 S TEXT(IC)="<<more>>" Q

 .N DTYP

 .S DTYP=$P(COMP(DIEN),U,2)

 .S DTYP=$S(DTYP="E":"element",DTYP="G":"group",1:"prompt")

 .S TEXT(IC)=$P(COMP(DIEN),U)_$J("",5)_DTYP

 S TEXT(IC+1)=""

 ;Ask Delete Y/N?

 D ASK(.ANS,.TEXT,HLP) Q:$G(ANS)'="Y"

 ;Use DIK to remove all unused components

 N DA,DIK

 S DIEN=0

 ;Scan list of unused components

 F  S DIEN=$O(COMP(DIEN)) Q:'DIEN  D

 .;Delete component dialog

 .S DA=DIEN,DIK="^PXRMD(801.41," D ^DIK

 Q

 ;

 ;Build list of components

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

COMP(PXRMDIEN,COMP) ;

 ;Build list of components

 D COMPR(PXRMDIEN,.COMP) Q:'$D(COMP)

 ;Get reminder dialog, group or element name and type

 N DDATA

 S DDATA=$G(^PXRMD(801.41,PXRMDIEN,0))

 ;Save for future use

 S COMP(0)=$P(DDATA,U)_U_$P(DDATA,U,4)

 Q

 ;

 ;Recursive call

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

COMPR(PXRMDIEN,COMP) ;

 N DIEN,DNAME,DNODE,DTYP,PARENT,SUB

 S DIEN=0,PARENT="LOCAL"

 ;Check if parent is national

 I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" S PARENT="NATIONAL"

 ;

 F  S DIEN=$O(^PXRMD(801.41,PXRMDIEN,10,"D",DIEN)) Q:'DIEN  D

 .;Ignore national components

 .I $P($G(^PXRMD(801.41,DIEN,100)),U)="N",PARENT'="NATIONAL" Q

 .;Ignore if in use

 .I $$USED(DIEN,PXRMDIEN) Q

 .;Save component dialog type and name

 .S DNODE=$G(^PXRMD(801.41,DIEN,0)),DNAME=$P(DNODE,U),DTYP=$P(DNODE,U,4)

 .S COMP(DIEN)=DNAME_U_DTYP

 .;For groups and element check sub-components

 .I (DTYP="G")!(DTYP="E") D COMPR(DIEN,.COMP)

 Q

 ;

 ;Check if in use

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

USED(DIEN,PXRMDIEN) ;

 N SUB,DINUSE

 S SUB=0,DINUSE=0

 F  S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB  D  Q:DINUSE

 .;In use by other than parent

 .I SUB'=PXRMDIEN S DINUSE=1

 Q DINUSE

 ;

 ;General help text routine.

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

HLP(CALL) ;

 N HTEXT

 N DIWF,DIWL,DIWR,IC

 S DIWF="C75",DIWL=0,DIWR=75

 ;

 I CALL=1 D

 .S HTEXT(1)="Enter 'Yes' to DELETE all sub-components listed above"

 .S HTEXT(2)="or enter 'No' to quit."

 K ^UTILITY($J,"W")

 S IC=""

 F  S IC=$O(HTEXT(IC)) Q:IC=""  D

 . S X=HTEXT(IC)

 . D ^DIWP

 W !

 S IC=0

 F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D

 . W !,^UTILITY($J,"W",0,IC,0)

 K ^UTILITY($J,"W")

 W !

 Q

PXRMDEDX  ;SLC/PJH - Delete dialog components ;12/12/2001

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

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

 +4       ;

 +5       ;Yes/No Prompts

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

ASK(YESNO,TEXT,HELP) ;

 +1        WRITE !

 +2        NEW DIR,X,Y

 +3        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +4        SET DIR(0)="YA0"

 +5        MERGE DIR("A")=TEXT

 +6        SET DIR("B")="Y"

 +7        SET DIR("?")="Enter Y or N. For detailed help type ??"

 +8        SET DIR("??")=U_"D HLP^PXRMDEDX(HELP)"

 +9        DO ^DIR

           KILL DIR

 +10       IF $DATA(DIROUT)

               SET DTOUT=1

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

               QUIT 

 +12       SET YESNO=$EXTRACT(Y(0))

 +13       QUIT 

 +14      ;

 +15      ;Give option to delete all descendents

 +16      ;-------------------------------------

DELETE(COMP) ;

 +1        NEW ANS,HLP,DIEN,DNAM,DTYP,IC,TEXT

 +2       ;Parent name and type

 +3        SET DNAM=$PIECE(COMP(0),U)

           SET DTYP=$PIECE(COMP(0),U,2)

 +4       ;Prompt information

 +5        IF DTYP="R"

               Begin DoDot:1

 +6                SET TEXT(1)="Reminder dialog "_DNAM_" had unused components."

 +7                SET TEXT="Delete all these components:"

               End DoDot:1

 +8        IF DTYP="G"

               Begin DoDot:1

 +9                SET TEXT(1)="Dialog group "_DNAM_" had unused elements or prompts."

 +10               SET TEXT="Delete all these components:"

               End DoDot:1

 +11       IF DTYP="E"

               Begin DoDot:1

 +12               SET TEXT(1)="Deleted dialog element "_DNAM_" had unused prompts."

 +13               SET TEXT="Delete all these components:"

               End DoDot:1

 +14      ;List component names

 +15       SET IC=2

           SET DIEN=0

           SET TEXT(2)=""

           SET HLP=1

 +16       FOR 

               SET DIEN=$ORDER(COMP(DIEN))

               IF 'DIEN

                   QUIT 

               Begin DoDot:1

 +17               SET IC=IC+1

                   IF IC>15

                       SET TEXT(IC)="<<more>>"

                       QUIT 

 +18               NEW DTYP

 +19               SET DTYP=$PIECE(COMP(DIEN),U,2)

 +20               SET DTYP=$SELECT(DTYP="E":"element",DTYP="G":"group",1:"prompt")

 +21               SET TEXT(IC)=$PIECE(COMP(DIEN),U)_$JUSTIFY("",5)_DTYP

               End DoDot:1

               IF IC>15

                   QUIT 

 +22       SET TEXT(IC+1)=""

 +23      ;Ask Delete Y/N?

 +24       DO ASK(.ANS,.TEXT,HLP)

           IF $GET(ANS)'="Y"

               QUIT 

 +25      ;Use DIK to remove all unused components

 +26       NEW DA,DIK

 +27       SET DIEN=0

 +28      ;Scan list of unused components

 +29       FOR 

               SET DIEN=$ORDER(COMP(DIEN))

               IF 'DIEN

                   QUIT 

               Begin DoDot:1

 +30      ;Delete component dialog

 +31               SET DA=DIEN

                   SET DIK="^PXRMD(801.41,"

                   DO ^DIK

               End DoDot:1

 +32       QUIT 

 +33      ;

 +34      ;Build list of components

 +35      ;------------------------

COMP(PXRMDIEN,COMP) ;

 +1       ;Build list of components

 +2        DO COMPR(PXRMDIEN,.COMP)

           IF '$DATA(COMP)

               QUIT 

 +3       ;Get reminder dialog, group or element name and type

 +4        NEW DDATA

 +5        SET DDATA=$GET(^PXRMD(801.41,PXRMDIEN,0))

 +6       ;Save for future use

 +7        SET COMP(0)=$PIECE(DDATA,U)_U_$PIECE(DDATA,U,4)

 +8        QUIT 

 +9       ;

 +10      ;Recursive call

 +11      ;--------------

COMPR(PXRMDIEN,COMP) ;

 +1        NEW DIEN,DNAME,DNODE,DTYP,PARENT,SUB

 +2        SET DIEN=0

           SET PARENT="LOCAL"

 +3       ;Check if parent is national

 +4        IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,100)),U)="N"

               SET PARENT="NATIONAL"

 +5       ;

 +6        FOR 

               SET DIEN=$ORDER(^PXRMD(801.41,PXRMDIEN,10,"D",DIEN))

               IF 'DIEN

                   QUIT 

               Begin DoDot:1

 +7       ;Ignore national components

 +8                IF $PIECE($GET(^PXRMD(801.41,DIEN,100)),U)="N"

                       IF PARENT'="NATIONAL"

                           QUIT 

 +9       ;Ignore if in use

 +10               IF $$USED(DIEN,PXRMDIEN)

                       QUIT 

 +11      ;Save component dialog type and name

 +12               SET DNODE=$GET(^PXRMD(801.41,DIEN,0))

                   SET DNAME=$PIECE(DNODE,U)

                   SET DTYP=$PIECE(DNODE,U,4)

 +13               SET COMP(DIEN)=DNAME_U_DTYP

 +14      ;For groups and element check sub-components

 +15               IF (DTYP="G")!(DTYP="E")

                       DO COMPR(DIEN,.COMP)

               End DoDot:1

 +16       QUIT 

 +17      ;

 +18      ;Check if in use

 +19      ;---------------

USED(DIEN,PXRMDIEN) ;

 +1        NEW SUB,DINUSE

 +2        SET SUB=0

           SET DINUSE=0

 +3        FOR 

               SET SUB=$ORDER(^PXRMD(801.41,"AD",DIEN,SUB))

               IF 'SUB

                   QUIT 

               Begin DoDot:1

 +4       ;In use by other than parent

 +5                IF SUB'=PXRMDIEN

                       SET DINUSE=1

               End DoDot:1

               IF DINUSE

                   QUIT 

 +6        QUIT DINUSE

 +7       ;

 +8       ;General help text routine.

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

HLP(CALL) ;

 +1        NEW HTEXT

 +2        NEW DIWF,DIWL,DIWR,IC

 +3        SET DIWF="C75"

           SET DIWL=0

           SET DIWR=75

 +4       ;

 +5        IF CALL=1

               Begin DoDot:1

 +6                SET HTEXT(1)="Enter 'Yes' to DELETE all sub-components listed above"

 +7                SET HTEXT(2)="or enter 'No' to quit."

               End DoDot:1

 +8        KILL ^UTILITY($JOB,"W")

 +9        SET IC=""

 +10       FOR 

               SET IC=$ORDER(HTEXT(IC))

               IF IC=""

                   QUIT 

               Begin DoDot:1

 +11               SET X=HTEXT(IC)

 +12               DO ^DIWP

               End DoDot:1

 +13       WRITE !

 +14       SET IC=0

 +15       FOR 

               SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))

               IF IC=""

                   QUIT 

               Begin DoDot:1

 +16               WRITE !,^UTILITY($JOB,"W",0,IC,0)

               End DoDot:1

 +17       KILL ^UTILITY($JOB,"W")

 +18       WRITE !

 +19       QUIT