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

ACMDELRG.m

Go to the documentation of this file. 
  1. ACMDELRG ; IHS/TUCSON/TMJ - DELETE AN ENTIRE REGISTER ; [ 12/19/05  11:36 AM ]
  1.  ;;2.0;ACM CASE MANAGEMENT SYSTEM;**2,6**;JAN 10, 1996
  1.  ;;Routine added for Patch 2
  1.  ;PATCH #6 IDENTIFIES THE REGISTER DEVELOPER NAME WHEN DELETING A REGISTER
  1.  ;;EP;ENTRY POINT
  1. EN D DELREG
  1. EXIT K ACMRGTP,ACMRG,ACMRGNA,ACMI,ACMGREF,ACMCTRL,ACMCTRLE,ACMCTRLP,ACMCTRLS,ACMCTRLX,ACMDELRG
  1.  Q
  1. DELREG W:$D(IOF) @IOF
  1.  W !,"WARNING  WARNING  WARNING  WARNING  WARNING  WARNING  WARNING  WARNING  WARNING",*7,*7,*7,!!,"The next procedure will allow you to COMPLETELY delete an entire register from"
  1.  W !,"the Case Management System.  The register, including all patients and all",!,"information on all patients will be deleted WITH NO POSSIBILITY of recovering"
  1.  W !,"any of the data.  Be absolutely certain this is what you want before proceding."
  1.  S DIR(0)="YO",DIR("A")="Delete an entire register",DIR("B")="NO"
  1.  W !
  1.  D ^DIR K DIR
  1.  Q:Y'=1
  1.  S (ACMRGTP,ACMDELRG)="" D ^ACMGTP
  1. DELREG2 ;SECOND SECURITY LEVEL FOR REGISTER DELETION
  1.  I '$D(ACMRG) W !!,"NO ACTION TAKEN",*7,*7 H 2 Q
  1.  S ACMRDEV=$P($G(^ACM(41.1,ACMRG,4)),U) ;IHS/CMI/TMJ PATCH #6
  1.  I ACMRDEV'="" S ACMRDEV=$P($G(^VA(200,ACMRDEV,0)),U)
  1.  I DUZ'=$P($G(^ACM(41.1,ACMRG,4)),U) W !!,$C(7),$C(7),?20,"You are NOT the Creator of this Register",!,?19,"Therefore, you cannot Delete this Register!",!!
  1.  I DUZ'=$P($G(^ACM(41.1,ACMRG,4)),U) W !,"Contact the Register Developer- "_ACMRDEV_" -for more information.",!! H 5 Q
  1.  W !!,"Are you certain you want to delete"
  1.  S DIR(0)="YO",DIR("A")="the entire "_ACMRGNA_" register",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  Q:Y'=1
  1.  W !!,"...DELETING ALL PATIENT RELATED DATA..."
  1.  F ACMI=42,43,44,45,46,47,48,51,53,54 S ACMGREF="^ACM("_ACMI_")" S DA=0 F  S DA=$O(@ACMGREF@("F",ACMRGNA,DA)) Q:'DA  W "." S DIK="^ACM("_ACMI_"," D ^DIK
  1.  K DIK,DIC,DA
  1.  W !!,"...DELETING ALL REGISTER RELATED LIST ENTRIES..."
  1.  F ACMI=42.1,43.1,44.1,45.1,47.1,48,50,51.1,53.1,54.1 S ACMGREF="^ACM("_ACMI_")" S DA(1)=0 F  S DA(1)=$O(@ACMGREF@("RG",ACMRG,DA(1))) Q:'DA(1)  D
  1.  .S DA=0
  1.  .F  S DA=$O(@ACMGREF@("RG",ACMRG,DA(1),DA)) Q:'DA  W "." S DIK="^ACM("_ACMI_","_DA(1)_",""RG""," D ^DIK
  1.  K DIK,DIC,DA
  1.  W !!,"...DELETING ALL PATIENTS FROM THE REGISTER..."
  1.  S DIK="^ACM(41,",DA=0
  1.  F  S DA=$O(^ACM(41,"B",ACMRG,DA)) Q:'DA  W "." D ^DIK
  1.  K DIK,DIC,DA
  1.  W !!,"...DELETING THE REGISTER..."
  1.  S DIK="^ACM(41.1,",DA=ACMRG D ^DIK
  1.  K DIK,DIC,DA
  1.  W !!,"The ",ACMRGNA," and all related data have been deleted." H 3
  1.  Q