Routine: ACMDELRG

ACMDELRG ; IHS/TUCSON/TMJ - DELETE AN ENTIRE REGISTER ; [ 12/19/05  11:36 AM ]

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**2,6**;JAN 10, 1996

 ;;Routine added for Patch 2

 ;PATCH #6 IDENTIFIES THE REGISTER DEVELOPER NAME WHEN DELETING A REGISTER

 ;;EP;ENTRY POINT

EN D DELREG

EXIT K ACMRGTP,ACMRG,ACMRGNA,ACMI,ACMGREF,ACMCTRL,ACMCTRLE,ACMCTRLP,ACMCTRLS,ACMCTRLX,ACMDELRG

DELREG W:$D(IOF) @IOF

 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"

 W !,"the Case Management System.  The register, including all patients and all",!,"information on all patients will be deleted WITH NO POSSIBILITY of recovering"

 W !,"any of the data.  Be absolutely certain this is what you want before proceding."

 S DIR(0)="YO",DIR("A")="Delete an entire register",DIR("B")="NO"

W !

 D ^DIR K DIR

 Q:Y'=1

 S (ACMRGTP,ACMDELRG)="" D ^ACMGTP

DELREG2 ;SECOND SECURITY LEVEL FOR REGISTER DELETION

 I '$D(ACMRG) W !!,"NO ACTION TAKEN",*7,*7 H 2 Q

 S ACMRDEV=$P($G(^ACM(41.1,ACMRG,4)),U) ;IHS/CMI/TMJ PATCH #6

 I ACMRDEV'="" S ACMRDEV=$P($G(^VA(200,ACMRDEV,0)),U)

 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!",!!

 I DUZ'=$P($G(^ACM(41.1,ACMRG,4)),U) W !,"Contact the Register Developer- "_ACMRDEV_" -for more information.",!! H 5 Q

 W !!,"Are you certain you want to delete"

 S DIR(0)="YO",DIR("A")="the entire "_ACMRGNA_" register",DIR("B")="NO"

 D ^DIR K DIR

 Q:Y'=1

 W !!,"...DELETING ALL PATIENT RELATED DATA..."

 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

 K DIK,DIC,DA

 W !!,"...DELETING ALL REGISTER RELATED LIST ENTRIES..."

 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

 .S DA=0

 .F  S DA=$O(@ACMGREF@("RG",ACMRG,DA(1),DA)) Q:'DA  W "." S DIK="^ACM("_ACMI_","_DA(1)_",""RG""," D ^DIK

 K DIK,DIC,DA

 W !!,"...DELETING ALL PATIENTS FROM THE REGISTER..."

 S DIK="^ACM(41,",DA=0

 F  S DA=$O(^ACM(41,"B",ACMRG,DA)) Q:'DA  W "." D ^DIK

 K DIK,DIC,DA

 W !!,"...DELETING THE REGISTER..."

 S DIK="^ACM(41.1,",DA=ACMRG D ^DIK

 K DIK,DIC,DA

 W !!,"The ",ACMRGNA," and all related data have been deleted." H 3

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

 +2       ;;Routine added for Patch 2

 +3       ;PATCH #6 IDENTIFIES THE REGISTER DEVELOPER NAME WHEN DELETING A REGISTER

 +4       ;;EP;ENTRY POINT

EN         DO DELREG

EXIT       KILL ACMRGTP,ACMRG,ACMRGNA,ACMI,ACMGREF,ACMCTRL,ACMCTRLE,ACMCTRLP,ACMCTRLS,ACMCTRLX,ACMDELRG

 +1        QUIT

DELREG     IF $DATA(IOF)

               WRITE @IOF

 +1        WRITE !,"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"

 +2        WRITE !,"the Case Management System.  The register, including all patients and all",!,"information on all patients will be deleted WITH NO POSSIBILITY of recovering"

 +3        WRITE !,"any of the data.  Be absolutely certain this is what you want before proceding."

 +4        SET DIR(0)="YO"

           SET DIR("A")="Delete an entire register"

           SET DIR("B")="NO"

 +5        WRITE !

 +6        DO ^DIR

           KILL DIR

 +7        IF Y'=1

               QUIT

 +8        SET (ACMRGTP,ACMDELRG)=""

           DO ^ACMGTP

DELREG2   ;SECOND SECURITY LEVEL FOR REGISTER DELETION

 +1        IF '$DATA(ACMRG)

               WRITE !!,"NO ACTION TAKEN",*7,*7

               HANG 2

               QUIT

 +2       ;IHS/CMI/TMJ PATCH #6

           SET ACMRDEV=$PIECE($GET(^ACM(41.1,ACMRG,4)),U)

 +3        IF ACMRDEV'=""

               SET ACMRDEV=$PIECE($GET(^VA(200,ACMRDEV,0)),U)

 +4        IF DUZ'=$PIECE($GET(^ACM(41.1,ACMRG,4)),U)

               WRITE !!,$CHAR(7),$CHAR(7),?20,"You are NOT the Creator of this Register",!,?19,"Therefore, you cannot Delete this Register!",!!

 +5        IF DUZ'=$PIECE($GET(^ACM(41.1,ACMRG,4)),U)

               WRITE !,"Contact the Register Developer- "_ACMRDEV_" -for more information.",!!

               HANG 5

               QUIT

 +6        WRITE !!,"Are you certain you want to delete"

 +7        SET DIR(0)="YO"

           SET DIR("A")="the entire "_ACMRGNA_" register"

           SET DIR("B")="NO"

 +8        DO ^DIR

           KILL DIR

 +9        IF Y'=1

               QUIT

 +10       WRITE !!,"...DELETING ALL PATIENT RELATED DATA..."

 +11       FOR ACMI=42,43,44,45,46,47,48,51,53,54

               SET ACMGREF="^ACM("_ACMI_")"

               SET DA=0

FOR

                   SET DA=$ORDER(@ACMGREF@("F",ACMRGNA,DA))

                   IF 'DA

                       QUIT

                   WRITE "."

                   SET DIK="^ACM("_ACMI_","

                   DO ^DIK

 +12       KILL DIK,DIC,DA

 +13       WRITE !!,"...DELETING ALL REGISTER RELATED LIST ENTRIES..."

 +14       FOR ACMI=42.1,43.1,44.1,45.1,47.1,48,50,51.1,53.1,54.1

               SET ACMGREF="^ACM("_ACMI_")"

               SET DA(1)=0

FOR

                   SET DA(1)=$ORDER(@ACMGREF@("RG",ACMRG,DA(1)))

                   IF 'DA(1)

                       QUIT

                   Begin DoDot:1

 +15                   SET DA=0

 +16                   FOR

                           SET DA=$ORDER(@ACMGREF@("RG",ACMRG,DA(1),DA))

                           IF 'DA

                               QUIT

                           WRITE "."

                           SET DIK="^ACM("_ACMI_","_DA(1)_",""RG"","

                           DO ^DIK

                   End DoDot:1

 +17       KILL DIK,DIC,DA

 +18       WRITE !!,"...DELETING ALL PATIENTS FROM THE REGISTER..."

 +19       SET DIK="^ACM(41,"

           SET DA=0

 +20       FOR

               SET DA=$ORDER(^ACM(41,"B",ACMRG,DA))

               IF 'DA

                   QUIT

               WRITE "."

               DO ^DIK

 +21       KILL DIK,DIC,DA

 +22       WRITE !!,"...DELETING THE REGISTER..."

 +23       SET DIK="^ACM(41.1,"

           SET DA=ACMRG

           DO ^DIK

 +24       KILL DIK,DIC,DA

 +25       WRITE !!,"The ",ACMRGNA," and all related data have been deleted."

           HANG 3

 +26       QUIT

ACMDELRG.m