QAPSDEL.m

QAPSDEL ;557/THM-DELETE A SURVEY, QUESTIONS, RESPONSES [ 06/20/95  12:40 PM ]

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

 ;

 D SCREEN^QAPUTIL

EN W @IOF,! S QAPHDR="Delete a Survey, Questions, and Responses" X QAPBAR W !!

 W "This program will ",BLDON,"COMPLETELY",BLDOFF," delete a survey, its questions",!,"and responses.",!!!

 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

 S OWNER=$P(Y(0),U,5)

 W ! K DIR S DIR("?")="Enter Y if it is the right one or N if not",DIR(0)="Y",DIR("A")="Is this the correct survey" D ^DIR G:$D(DTOUT) EXIT G:Y=0!(X[U)!($D(DIRUT)) EN

 I DUZ'=OWNER W *7,!!,"This survey belongs to ",BLDON,$S($D(^VA(200,+OWNER,0)):$P(^(0),U,1),1:"an unknown survey developer"),BLDOFF,".",!," Be sure you want to delete ",BLDON,"THIS",BLDOFF," survey !!",! H 1

 S DELETE=0 W !! K DIR

 S DIR("?")="Enter Y if you are COMPLETELY sure or N if not"

 S DIR(0)="Y",DIR("A")="Are you absolutely sure" D ^DIR G:$D(DTOUT) EXIT G:Y=0!(X[U)!($D(DIRUT)) EN

 I Y=1 DO

 .W !!,*7,"Survey now DISABLED ... ",!! H 1 S DIE="^QA(748,",DR=".05///e",DA=SURVEY D ^DIE

 .L ^QA(748,SURVEY,0) S DA=SURVEY,DIK="^QA(748," W !,"Deleting the survey . . ." D ^DIK W "."

 .L ^QA(748.25,SURVEY,0) S DA=SURVEY,DIK="^QA(748.25," W !,"Deleting the questions . . ." D ^DIK W "."

 .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 "."

 .LOCK  H 1

 G EN

 ;

EXIT G EXIT^QAPUTIL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAPSDEL   1554     printed  Apr 09, 2024@21:40:57                                                                                                                                                                                                     Page 2

QAPSDEL   ;557/THM-DELETE A SURVEY, QUESTIONS, RESPONSES [ 06/20/95  12:40 PM ]

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

 +2       ;

 +3        DO SCREEN^QAPUTIL

EN         WRITE @IOF,!

           SET QAPHDR="Delete a Survey, Questions, and Responses"

           XECUTE QAPBAR

           WRITE !!

 +1        WRITE "This program will ",BLDON,"COMPLETELY",BLDOFF," delete a survey, its questions",!,"and responses.",!!!

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

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

           SET DIC(0)="AEQMZ"

           DO ^DIC

           if X=""!(X[U)

               GOTO EXIT

           SET SURVEY=+Y

 +4        SET OWNER=$PIECE(Y(0),U,5)

 +5        WRITE !

           KILL DIR

           SET DIR("?")="Enter Y if it is the right one or N if not"

           SET DIR(0)="Y"

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

           DO ^DIR

           if $DATA(DTOUT)

               GOTO EXIT

           if Y=0!(X[U)!($DATA(DIRUT))

               GOTO EN

 +6        IF DUZ'=OWNER

               WRITE *7,!!,"This survey belongs to ",BLDON,$SELECT($DATA(^VA(200,+OWNER,0)):$PIECE(^(0),U,1),1:"an unknown survey developer"),BLDOFF,".",!," Be sure you want to delete ",BLDON,"THIS",BLDOFF," survey !!",!

               HANG 1

 +7        SET DELETE=0

           WRITE !!

           KILL DIR

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

 +9        SET DIR(0)="Y"

           SET DIR("A")="Are you absolutely sure"

           DO ^DIR

           if $DATA(DTOUT)

               GOTO EXIT

           if Y=0!(X[U)!($DATA(DIRUT))

               GOTO EN

 +10       IF Y=1

               Begin DoDot:1

 +11               WRITE !!,*7,"Survey now DISABLED ... ",!!

                   HANG 1

                   SET DIE="^QA(748,"

                   SET DR=".05///e"

                   SET DA=SURVEY

                   DO ^DIE

 +12               LOCK ^QA(748,SURVEY,0)

                   SET DA=SURVEY

                   SET DIK="^QA(748,"

                   WRITE !,"Deleting the survey . . ."

                   DO ^DIK

                   WRITE "."

 +13               LOCK ^QA(748.25,SURVEY,0)

                   SET DA=SURVEY

                   SET DIK="^QA(748.25,"

                   WRITE !,"Deleting the questions . . ."

                   DO ^DIK

                   WRITE "."

 +14               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 "."

 +15               LOCK 

                   HANG 1

               End DoDot:1

 +16       GOTO EN

 +17      ;

EXIT       GOTO EXIT^QAPUTIL