| [613] | 1 | QAPCLEAR ;557/THM-CLEAR A SURVEY OF RESPONSES [ 02/19/95  9:53 PM ]
 | 
|---|
 | 2 |  ;;2.0;Survey Generator;;Jun 20, 1995
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  D SCREEN^QAPUTIL
 | 
|---|
 | 5 | 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.",!!
 | 
|---|
 | 6 |  K DIC S DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"
 | 
|---|
 | 7 |  S DIC="^QA(748,",DIC(0)="AEQMZ" D ^DIC G:X=""!(X[U) EXIT  S SURVEY=+Y
 | 
|---|
 | 8 |  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
 | 
|---|
 | 9 |  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
 | 
|---|
 | 10 |  I Y=1 S DELETE=1
 | 
|---|
 | 11 |  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
 | 
|---|
 | 12 |  W !!,"Responses deleted: ",CNT,!
 | 
|---|
 | 13 |  K DIR S DIR(0)="E" D ^DIR I X'[U,'$D(DIRUT) G EN
 | 
|---|
 | 14 |  ;
 | 
|---|
 | 15 | EXIT G EXIT^QAPUTIL
 | 
|---|