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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDEDX 3419 printed Dec 13, 2024@01:43:39 Page 2
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
