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 ---[H[J[2J[HQAPSDEL 1554 printed Nov 22, 2024@17:48:30 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
