- 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 Feb 19, 2025@00:05:02 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