Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMLREX

PXRMLREX.m

Go to the documentation of this file. 
  1. PXRMLREX ;SLC/PJH - Delete rule components ;07/03/2002
  1.  ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  1.  ;
  1.  ;=====================================================================
  1.  ;
  1.  ;Yes/No Prompts
  1.  ;--------------
  1. ASK(YESNO,TEXT,HELP) ;
  1.  W !
  1.  N DIR,X,Y
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="YA0"
  1.  M DIR("A")=TEXT
  1.  S DIR("B")="Y"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HLP^PXRMLREX(HELP)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  S YESNO=$E(Y(0))
  1.  Q
  1.  ;
  1.  ;Give option to delete all descendents
  1.  ;-------------------------------------
  1. DELETE(COMP) ;
  1.  N ANS,HLP,LRIEN,LRNAM,LRTYP,IC,TEXT
  1.  ;Parent name and type
  1.  S LRNAM=$P(COMP(0),U)
  1.  ;Prompt information
  1.  S TEXT(1)="List Rule Set "_LRNAM_" had unused components."
  1.  S TEXT="Delete all these component rules:"
  1.  ;List component names
  1.  S IC=2,LRIEN=0,TEXT(2)="",HLP=1
  1.  F  S LRIEN=$O(COMP(LRIEN)) Q:'LRIEN  D  Q:IC>15
  1.  .S IC=IC+1 I IC>15 S TEXT(IC)="<<more>>" Q
  1.  .N LRTYP
  1.  .S LRTYP=$P(COMP(LRIEN),U,2)
  1.  .S LRTYP=$S(LRTYP=1:"list rule",LRTYP=2:"reminder rule",1:"output rule")
  1.  .S TEXT(IC)=$P(COMP(LRIEN),U)_$J("",5)_LRTYP
  1.  S TEXT(IC+1)=""
  1.  ;Ask Delete Y/N?
  1.  D ASK(.ANS,.TEXT,HLP) Q:$G(ANS)'="Y"
  1.  ;Use DIK to remove all unused components
  1.  N DA,DIK
  1.  S LRIEN=0
  1.  ;Scan list of unused components
  1.  F  S LRIEN=$O(COMP(LRIEN)) Q:'LRIEN  D
  1.  .;Delete component dialog
  1.  .S DA=LRIEN,DIK="^PXRM(810.4," D ^DIK
  1.  Q
  1.  ;
  1.  ;Build list of components
  1.  ;------------------------
  1. COMP(IEN,COMP) ;
  1.  ;Build list of components
  1.  D COMPR(IEN,.COMP) Q:'$D(COMP)
  1.  ;Get reminder dialog, group or element name and type
  1.  N DATA
  1.  S DATA=$G(^PXRM(810.4,IEN,0))
  1.  ;Save for future use
  1.  S COMP(0)=$P(DATA,U)_U_$P(DATA,U,4)
  1.  Q
  1.  ;
  1.  ;Recursive call
  1.  ;--------------
  1. COMPR(IEN,COMP) ;
  1.  N DATA,LRIEN,LRNAME,LRTYP,PARENT,SUB
  1.  S LRIEN=0,PARENT="LOCAL"
  1.  ;Check if parent is national
  1.  I $P($G(^PXRM(810.4,IEN,100)),U)="N" S PARENT="NATIONAL"
  1.  ;
  1.  F  S LRIEN=$O(^PXRM(810.4,IEN,30,"D",LRIEN)) Q:'LRIEN  D
  1.  .;Ignore national components
  1.  .I $P($G(^PXRM(810.4,LRIEN,100)),U)="N",PARENT'="NATIONAL" Q
  1.  .;Ignore if in use
  1.  .I $$USED(LRIEN,IEN) Q
  1.  .;Save component dialog type and name
  1.  .S DATA=$G(^PXRM(810.4,LRIEN,0)),LRNAME=$P(DATA,U),LRTYP=$P(DATA,U,3)
  1.  .S COMP(LRIEN)=LRNAME_U_LRTYP
  1.  .;For groups and element check sub-components
  1.  .I (LRTYP="G")!(LRTYP="E") D COMPR(LRIEN,.COMP)
  1.  Q
  1.  ;
  1.  ;Check if in use
  1.  ;---------------
  1. USED(LRIEN,IEN) ;
  1.  N SUB,DINUSE
  1.  S SUB=0,DINUSE=0
  1.  F  S SUB=$O(^PXRM(810.4,"AD",LRIEN,SUB)) Q:'SUB  D  Q:DINUSE
  1.  .;In use by other than parent
  1.  .I SUB'=IEN S DINUSE=1
  1.  Q DINUSE
  1.  ;
  1.  ;General help text routine.
  1.  ;--------------------------
  1. HLP(CALL) ;
  1.  N HTEXT
  1.  N DIWF,DIWL,DIWR,IC
  1.  S DIWF="C75",DIWL=0,DIWR=75
  1.  ;
  1.  I CALL=1 D
  1.  .S HTEXT(1)="Enter 'Yes' to DELETE all sub-components listed above"
  1.  .S HTEXT(2)="or enter 'No' to quit."
  1.  ;
  1.  D HELP^PXRMEUT(.HTEXT)
  1.  Q