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 ---[H[J[2J[HQAPCLEAR 1163 printed Dec 13, 2024@02:38:11 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
