QAPCLEAR.m

QAPCLEAR ;557/THM-CLEAR A SURVEY OF RESPONSES [ 02/19/95  9:53 PM ]

 ;;2.0;Survey Generator;;Jun 20, 1995

 ;

 D SCREEN^QAPUTIL

EN W @IOF,! S QAPHDR="Clear a Survey of Responses" X QAPBAR W !?45,BLDON,"Type RETURN or ^ to exit",BLDOFF,!! W "This program will COMPLETELY clear a survey of its associated responses.",!!

 K DIC S DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"

 S DIC="^QA(748,",DIC(0)="AEQMZ" D ^DIC G:X=""!(X[U) EXIT  S SURVEY=+Y

 W ! K DIR S DIR("?")="Enter Y if the correct one or N if not.",DIR(0)="Y",DIR("A")="Is this the correct survey",DIR("B")="YES" D ^DIR G:X[U!($D(DIRUT)) EXIT I Y'=1 G EN

 S DELETE=0 W !! K DIR S DIR("?")="Enter Y if you are sure or N if not.",DIR(0)="Y",DIR("A")="Are you sure you want to remove all responses to this survey",DIR("B")="NO" D ^DIR G:X[U!($D(DIRUT)) EXIT I Y'=1 G EN

 I Y=1 S DELETE=1

 S CNT=0 I DELETE=1 W !,"Deleting the responses . . ." F DA=0:0 S DA=$O(^QA(748.3,"B",SURVEY,DA)) Q:DA=""  S DIK="^QA(748.3," D ^DIK W "." S CNT=CNT+1

 W !!,"Responses deleted: ",CNT,!

 K DIR S DIR(0)="E" D ^DIR I X'[U,'$D(DIRUT) G EN

 ;

EXIT G EXIT^QAPUTIL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAPCLEAR   1163     printed  Apr 09, 2024@21:40:32                                                                                                                                                                                                    Page 2

QAPCLEAR  ;557/THM-CLEAR A SURVEY OF RESPONSES [ 02/19/95  9:53 PM ]

 +1       ;;2.0;Survey Generator;;Jun 20, 1995

 +2       ;

 +3        DO SCREEN^QAPUTIL

EN         WRITE @IOF,!

           SET QAPHDR="Clear a Survey of Responses"

           XECUTE QAPBAR

           WRITE !?45,BLDON,"Type RETURN or ^ to exit",BLDOFF,!!

           WRITE "This program will COMPLETELY clear a survey of its associated responses.",!!

 +1        KILL DIC

           SET DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"

 +2        SET DIC="^QA(748,"

           SET DIC(0)="AEQMZ"

           DO ^DIC

           if X=""!(X[U)

               GOTO EXIT

           SET SURVEY=+Y

 +3        WRITE !

           KILL DIR

           SET DIR("?")="Enter Y if the correct one or N if not."

           SET DIR(0)="Y"

           SET DIR("A")="Is this the correct survey"

           SET DIR("B")="YES"

           DO ^DIR

           if X[U!($DATA(DIRUT))

               GOTO EXIT

           IF Y'=1

               GOTO EN

 +4        SET DELETE=0

           WRITE !!

           KILL DIR

           SET DIR("?")="Enter Y if you are sure or N if not."

           SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to remove all responses to this survey"

           SET DIR("B")="NO"

           DO ^DIR

           if X[U!($DATA(DIRUT))

               GOTO EXIT

           IF Y'=1

               GOTO EN

 +5        IF Y=1

               SET DELETE=1

 +6        SET CNT=0

           IF DELETE=1

               WRITE !,"Deleting the responses . . ."

               FOR DA=0:0

                   SET DA=$ORDER(^QA(748.3,"B",SURVEY,DA))

                   if DA=""

                       QUIT 

                   SET DIK="^QA(748.3,"

                   DO ^DIK

                   WRITE "."

                   SET CNT=CNT+1

 +7        WRITE !!,"Responses deleted: ",CNT,!

 +8        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

           IF X'[U

               IF '$DATA(DIRUT)

                   GOTO EN

 +9       ;

EXIT       GOTO EXIT^QAPUTIL