| [613] | 1 | PXRMLREX ;SLC/PJH - Delete rule components ;07/03/2002
|
|---|
| 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^PXRMLREX(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,LRIEN,LRNAM,LRTYP,IC,TEXT
|
|---|
| 27 | ;Parent name and type
|
|---|
| 28 | S LRNAM=$P(COMP(0),U)
|
|---|
| 29 | ;Prompt information
|
|---|
| 30 | S TEXT(1)="List Rule Set "_LRNAM_" had unused components."
|
|---|
| 31 | S TEXT="Delete all these component rules:"
|
|---|
| 32 | ;List component names
|
|---|
| 33 | S IC=2,LRIEN=0,TEXT(2)="",HLP=1
|
|---|
| 34 | F S LRIEN=$O(COMP(LRIEN)) Q:'LRIEN D Q:IC>15
|
|---|
| 35 | .S IC=IC+1 I IC>15 S TEXT(IC)="<<more>>" Q
|
|---|
| 36 | .N LRTYP
|
|---|
| 37 | .S LRTYP=$P(COMP(LRIEN),U,2)
|
|---|
| 38 | .S LRTYP=$S(LRTYP=1:"list rule",LRTYP=2:"reminder rule",1:"output rule")
|
|---|
| 39 | .S TEXT(IC)=$P(COMP(LRIEN),U)_$J("",5)_LRTYP
|
|---|
| 40 | S TEXT(IC+1)=""
|
|---|
| 41 | ;Ask Delete Y/N?
|
|---|
| 42 | D ASK(.ANS,.TEXT,HLP) Q:$G(ANS)'="Y"
|
|---|
| 43 | ;Use DIK to remove all unused components
|
|---|
| 44 | N DA,DIK
|
|---|
| 45 | S LRIEN=0
|
|---|
| 46 | ;Scan list of unused components
|
|---|
| 47 | F S LRIEN=$O(COMP(LRIEN)) Q:'LRIEN D
|
|---|
| 48 | .;Delete component dialog
|
|---|
| 49 | .S DA=LRIEN,DIK="^PXRM(810.4," D ^DIK
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | ;Build list of components
|
|---|
| 53 | ;------------------------
|
|---|
| 54 | COMP(IEN,COMP) ;
|
|---|
| 55 | ;Build list of components
|
|---|
| 56 | D COMPR(IEN,.COMP) Q:'$D(COMP)
|
|---|
| 57 | ;Get reminder dialog, group or element name and type
|
|---|
| 58 | N DATA
|
|---|
| 59 | S DATA=$G(^PXRM(810.4,IEN,0))
|
|---|
| 60 | ;Save for future use
|
|---|
| 61 | S COMP(0)=$P(DATA,U)_U_$P(DATA,U,4)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | ;Recursive call
|
|---|
| 65 | ;--------------
|
|---|
| 66 | COMPR(IEN,COMP) ;
|
|---|
| 67 | N DATA,LRIEN,LRNAME,LRTYP,PARENT,SUB
|
|---|
| 68 | S LRIEN=0,PARENT="LOCAL"
|
|---|
| 69 | ;Check if parent is national
|
|---|
| 70 | I $P($G(^PXRM(810.4,IEN,100)),U)="N" S PARENT="NATIONAL"
|
|---|
| 71 | ;
|
|---|
| 72 | F S LRIEN=$O(^PXRM(810.4,IEN,30,"D",LRIEN)) Q:'LRIEN D
|
|---|
| 73 | .;Ignore national components
|
|---|
| 74 | .I $P($G(^PXRM(810.4,LRIEN,100)),U)="N",PARENT'="NATIONAL" Q
|
|---|
| 75 | .;Ignore if in use
|
|---|
| 76 | .I $$USED(LRIEN,IEN) Q
|
|---|
| 77 | .;Save component dialog type and name
|
|---|
| 78 | .S DATA=$G(^PXRM(810.4,LRIEN,0)),LRNAME=$P(DATA,U),LRTYP=$P(DATA,U,3)
|
|---|
| 79 | .S COMP(LRIEN)=LRNAME_U_LRTYP
|
|---|
| 80 | .;For groups and element check sub-components
|
|---|
| 81 | .I (LRTYP="G")!(LRTYP="E") D COMPR(LRIEN,.COMP)
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | ;Check if in use
|
|---|
| 85 | ;---------------
|
|---|
| 86 | USED(LRIEN,IEN) ;
|
|---|
| 87 | N SUB,DINUSE
|
|---|
| 88 | S SUB=0,DINUSE=0
|
|---|
| 89 | F S SUB=$O(^PXRM(810.4,"AD",LRIEN,SUB)) Q:'SUB D Q:DINUSE
|
|---|
| 90 | .;In use by other than parent
|
|---|
| 91 | .I SUB'=IEN S DINUSE=1
|
|---|
| 92 | Q DINUSE
|
|---|
| 93 | ;
|
|---|
| 94 | ;General help text routine.
|
|---|
| 95 | ;--------------------------
|
|---|
| 96 | HLP(CALL) ;
|
|---|
| 97 | N HTEXT
|
|---|
| 98 | N DIWF,DIWL,DIWR,IC
|
|---|
| 99 | S DIWF="C75",DIWL=0,DIWR=75
|
|---|
| 100 | ;
|
|---|
| 101 | I CALL=1 D
|
|---|
| 102 | .S HTEXT(1)="Enter 'Yes' to DELETE all sub-components listed above"
|
|---|
| 103 | .S HTEXT(2)="or enter 'No' to quit."
|
|---|
| 104 | ;
|
|---|
| 105 | D HELP^PXRMEUT(.HTEXT)
|
|---|
| 106 | Q
|
|---|
