source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLREX.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1PXRMLREX ;SLC/PJH - Delete rule components ;07/03/2002
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;=====================================================================
5 ;
6 ;Yes/No Prompts
7 ;--------------
8ASK(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 ;-------------------------------------
25DELETE(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 ;------------------------
54COMP(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 ;--------------
66COMPR(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 ;---------------
86USED(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 ;--------------------------
96HLP(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
Note: See TracBrowser for help on using the repository browser.