Routine: AMHRSFD

AMHRSFD ; IHS/CMI/LAB - reset flag field ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

RESET ;EP - called from option

 W !!,"This option will reset all patient flag fields to null.  This should be done",!,"each time you want to flag patients for a different reason.",!

AO ;all or one

 S AMHX="" S DIR(0)="S^A:ALL FLAGS;O:ONE PARTICULAR FLAG",DIR("A")="Reset which flags",DIR("B")="A" K DA D ^DIR K DIR

 G:$D(DIRUT) XIT

 S AMHAO=Y

 I AMHAO="A" G SURE

WHICH ;

 S AMHY="",DIR(0)="9002011.55,.09",DIR("A")="Which flag should be removed" K DA D ^DIR K DIR

 G:$D(DIRUT) AO

 S AMHY=Y

SURE ;

 S DIR(0)="Y",DIR("A")="Are you sure you want to do this",DIR("B")="N" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 G:'Y XIT

 W !,"Hold on... resetting data.."

 S AMHX=0 F  S AMHX=$O(^AMHPATR(AMHX)) Q:AMHX'=+AMHX  D

 .I AMHAO="O",AMHY'=$P(^AMHPATR(AMHX,0),U,9) Q

 .S DR=".09///@;.11///@",DIE="^AMHPATR(",DA=AMHX D ^DIE K DA,DR,DIE W AMHX,":"

XIT ;

 W !,"All done.",!

 K AMHX,DA,DIE,DIU,DIV,DIY,AMHAO,AMHY

AMHRSFD   ; IHS/CMI/LAB - reset flag field ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;

RESET     ;EP - called from option

 +1        WRITE !!,"This option will reset all patient flag fields to null.  This should be done",!,"each time you want to flag patients for a different reason.",!

AO        ;all or one

 +1        SET AMHX=""

           SET DIR(0)="S^A:ALL FLAGS;O:ONE PARTICULAR FLAG"

           SET DIR("A")="Reset which flags"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET AMHAO=Y

 +4        IF AMHAO="A"

               GOTO SURE

WHICH     ;

 +1        SET AMHY=""

           SET DIR(0)="9002011.55,.09"

           SET DIR("A")="Which flag should be removed"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO AO

 +3        SET AMHY=Y

SURE      ;

 +1        SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to do this"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               QUIT

 +3        IF 'Y

               GOTO XIT

 +4        WRITE !,"Hold on... resetting data.."

 +5        SET AMHX=0

FOR

               SET AMHX=$ORDER(^AMHPATR(AMHX))

               IF AMHX'=+AMHX

                   QUIT

               Begin DoDot:1

 +6                IF AMHAO="O"

                       IF AMHY'=$PIECE(^AMHPATR(AMHX,0),U,9)

                           QUIT

 +7                SET DR=".09///@;.11///@"

                   SET DIE="^AMHPATR("

                   SET DA=AMHX

                   DO ^DIE

                   KILL DA,DR,DIE

                   WRITE AMHX,":"

               End DoDot:1

XIT       ;

 +1        WRITE !,"All done.",!

 +2        KILL AMHX,DA,DIE,DIU,DIV,DIY,AMHAO,AMHY

 +3        QUIT

AMHRSFD.m