ACMDELPT.m

ACMDELPT ; IHS/TUCSON/TMJ - DELETE PATIENTS FROM AN ENTIRE REGISTER ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 ;;ALLOWS USER TO DELETE ONLY PATIENTS FROM REG

EN D DELREG

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

 Q

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 ALL PATIENTS 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

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

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

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

 D ^DIR K DIR

 Q:Y'=1

 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 !!,"The ",ACMRGNA," PATIENTS have been deleted." H 3

 Q

ACMDELPT  ; IHS/TUCSON/TMJ - DELETE PATIENTS FROM AN ENTIRE REGISTER ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 +2       ;;ALLOWS USER TO DELETE ONLY PATIENTS FROM REG

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 ALL PATIENTS 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

 +9        IF '$DATA(ACMRG)

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

               HANG 2

               QUIT 

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

 +11       SET DIR(0)="YO"

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

           SET DIR("B")="NO"

 +12       DO ^DIR

           KILL DIR

 +13       IF Y'=1

               QUIT 

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

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

           SET DA=0

 +16       FOR 

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

               IF 'DA

                   QUIT 

               WRITE "."

               DO ^DIK

 +17       KILL DIK,DIC,DA

 +18       WRITE !!,"The ",ACMRGNA," PATIENTS have been deleted."

           HANG 3

 +19       QUIT