| [613] | 1 | PXRMDEDX ;SLC/PJH - Delete dialog components ;12/12/2001
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | ;=====================================================================
|
|---|
| 5 | ;
|
|---|
| 6 | ;Yes/No Prompts
|
|---|
| 7 | ;--------------
|
|---|
| 8 | ASK(YESNO,TEXT,HELP) ;
|
|---|
| 9 | W !
|
|---|
| 10 | N DIR,X,Y
|
|---|
| 11 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 12 | S DIR(0)="YA0"
|
|---|
| 13 | M DIR("A")=TEXT
|
|---|
| 14 | S DIR("B")="Y"
|
|---|
| 15 | S DIR("?")="Enter Y or N. For detailed help type ??"
|
|---|
| 16 | S DIR("??")=U_"D HLP^PXRMDEDX(HELP)"
|
|---|
| 17 | D ^DIR K DIR
|
|---|
| 18 | I $D(DIROUT) S DTOUT=1
|
|---|
| 19 | I $D(DTOUT)!($D(DUOUT)) Q
|
|---|
| 20 | S YESNO=$E(Y(0))
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ;Give option to delete all descendents
|
|---|
| 24 | ;-------------------------------------
|
|---|
| 25 | DELETE(COMP) ;
|
|---|
| 26 | N ANS,HLP,DIEN,DNAM,DTYP,IC,TEXT
|
|---|
| 27 | ;Parent name and type
|
|---|
| 28 | S DNAM=$P(COMP(0),U),DTYP=$P(COMP(0),U,2)
|
|---|
| 29 | ;Prompt information
|
|---|
| 30 | I DTYP="R" D
|
|---|
| 31 | .S TEXT(1)="Reminder dialog "_DNAM_" had unused components."
|
|---|
| 32 | .S TEXT="Delete all these components:"
|
|---|
| 33 | I DTYP="G" D
|
|---|
| 34 | .S TEXT(1)="Dialog group "_DNAM_" had unused elements or prompts."
|
|---|
| 35 | .S TEXT="Delete all these components:"
|
|---|
| 36 | I DTYP="E" D
|
|---|
| 37 | .S TEXT(1)="Deleted dialog element "_DNAM_" had unused prompts."
|
|---|
| 38 | .S TEXT="Delete all these components:"
|
|---|
| 39 | ;List component names
|
|---|
| 40 | S IC=2,DIEN=0,TEXT(2)="",HLP=1
|
|---|
| 41 | F S DIEN=$O(COMP(DIEN)) Q:'DIEN D Q:IC>15
|
|---|
| 42 | .S IC=IC+1 I IC>15 S TEXT(IC)="<<more>>" Q
|
|---|
| 43 | .N DTYP
|
|---|
| 44 | .S DTYP=$P(COMP(DIEN),U,2)
|
|---|
| 45 | .S DTYP=$S(DTYP="E":"element",DTYP="G":"group",1:"prompt")
|
|---|
| 46 | .S TEXT(IC)=$P(COMP(DIEN),U)_$J("",5)_DTYP
|
|---|
| 47 | S TEXT(IC+1)=""
|
|---|
| 48 | ;Ask Delete Y/N?
|
|---|
| 49 | D ASK(.ANS,.TEXT,HLP) Q:$G(ANS)'="Y"
|
|---|
| 50 | ;Use DIK to remove all unused components
|
|---|
| 51 | N DA,DIK
|
|---|
| 52 | S DIEN=0
|
|---|
| 53 | ;Scan list of unused components
|
|---|
| 54 | F S DIEN=$O(COMP(DIEN)) Q:'DIEN D
|
|---|
| 55 | .;Delete component dialog
|
|---|
| 56 | .S DA=DIEN,DIK="^PXRMD(801.41," D ^DIK
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | ;Build list of components
|
|---|
| 60 | ;------------------------
|
|---|
| 61 | COMP(PXRMDIEN,COMP) ;
|
|---|
| 62 | ;Build list of components
|
|---|
| 63 | D COMPR(PXRMDIEN,.COMP) Q:'$D(COMP)
|
|---|
| 64 | ;Get reminder dialog, group or element name and type
|
|---|
| 65 | N DDATA
|
|---|
| 66 | S DDATA=$G(^PXRMD(801.41,PXRMDIEN,0))
|
|---|
| 67 | ;Save for future use
|
|---|
| 68 | S COMP(0)=$P(DDATA,U)_U_$P(DDATA,U,4)
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | ;Recursive call
|
|---|
| 72 | ;--------------
|
|---|
| 73 | COMPR(PXRMDIEN,COMP) ;
|
|---|
| 74 | N DIEN,DNAME,DNODE,DTYP,PARENT,SUB
|
|---|
| 75 | S DIEN=0,PARENT="LOCAL"
|
|---|
| 76 | ;Check if parent is national
|
|---|
| 77 | I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" S PARENT="NATIONAL"
|
|---|
| 78 | ;
|
|---|
| 79 | F S DIEN=$O(^PXRMD(801.41,PXRMDIEN,10,"D",DIEN)) Q:'DIEN D
|
|---|
| 80 | .;Ignore national components
|
|---|
| 81 | .I $P($G(^PXRMD(801.41,DIEN,100)),U)="N",PARENT'="NATIONAL" Q
|
|---|
| 82 | .;Ignore if in use
|
|---|
| 83 | .I $$USED(DIEN,PXRMDIEN) Q
|
|---|
| 84 | .;Save component dialog type and name
|
|---|
| 85 | .S DNODE=$G(^PXRMD(801.41,DIEN,0)),DNAME=$P(DNODE,U),DTYP=$P(DNODE,U,4)
|
|---|
| 86 | .S COMP(DIEN)=DNAME_U_DTYP
|
|---|
| 87 | .;For groups and element check sub-components
|
|---|
| 88 | .I (DTYP="G")!(DTYP="E") D COMPR(DIEN,.COMP)
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | ;Check if in use
|
|---|
| 92 | ;---------------
|
|---|
| 93 | USED(DIEN,PXRMDIEN) ;
|
|---|
| 94 | N SUB,DINUSE
|
|---|
| 95 | S SUB=0,DINUSE=0
|
|---|
| 96 | F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB D Q:DINUSE
|
|---|
| 97 | .;In use by other than parent
|
|---|
| 98 | .I SUB'=PXRMDIEN S DINUSE=1
|
|---|
| 99 | Q DINUSE
|
|---|
| 100 | ;
|
|---|
| 101 | ;General help text routine.
|
|---|
| 102 | ;--------------------------
|
|---|
| 103 | HLP(CALL) ;
|
|---|
| 104 | N HTEXT
|
|---|
| 105 | N DIWF,DIWL,DIWR,IC
|
|---|
| 106 | S DIWF="C75",DIWL=0,DIWR=75
|
|---|
| 107 | ;
|
|---|
| 108 | I CALL=1 D
|
|---|
| 109 | .S HTEXT(1)="Enter 'Yes' to DELETE all sub-components listed above"
|
|---|
| 110 | .S HTEXT(2)="or enter 'No' to quit."
|
|---|
| 111 | K ^UTILITY($J,"W")
|
|---|
| 112 | S IC=""
|
|---|
| 113 | F S IC=$O(HTEXT(IC)) Q:IC="" D
|
|---|
| 114 | . S X=HTEXT(IC)
|
|---|
| 115 | . D ^DIWP
|
|---|
| 116 | W !
|
|---|
| 117 | S IC=0
|
|---|
| 118 | F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
|
|---|
| 119 | . W !,^UTILITY($J,"W",0,IC,0)
|
|---|
| 120 | K ^UTILITY($J,"W")
|
|---|
| 121 | W !
|
|---|
| 122 | Q
|
|---|
