- 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 Feb 19, 2025@00:04:38 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
