- QAPEDINC ;557/THM-EDIT AN INCOMPLETE SURVEY [ 05/31/95 1:32 PM ] ;10/27/95 09:39
- ;;2.0;Survey Generator;**3**;Jun 20, 1995
- ;
- D SCREEN^QAPUTIL
- EN W @IOF,! S QAPHDR="Edit an Incomplete Survey" X QAPBAR
- W !!,"This option will allow you to edit the answers you have entered on a survey",!,"so far. You must use the 'Participate in a Survey' option to finish it.",!!
- S DIC="^QA(748,",DIC(0)="AEQMZ" D ^DIC G:X=""!(X[U) EXIT S SURVEY=+Y
- K DIR S DIR(0)="Y",DIR("A")="Is this the correct survey" D ^DIR G:X[U!($D(DIRUT)) EXIT I Y=0 G EN
- S SVSTAT=$P(^QA(748,SURVEY,0),U,4) I SVSTAT'="r" W *7,!!,"This survey is not available for selection at this time. Its current",!,"status is ",$S(SVSTAT="d":"Under Maintenance/Development",1:"Active Life Expired"),".",!! H 3 G EN
- ;read index backwards to get last response to see if suspended
- S X="`"_DUZ D HASH^XUSHSHP S USER=X,FILEDA=$O(^QA(748.3,"AC",USER,SURVEY,"zz"),-1) I FILEDA="" W *7,!!,"You do not have a response on file for this survey.",!! H 3 G EN
- I $P(^QA(748.3,FILEDA,0),U,3)'="s" W *7,!!,"Your response does not have a suspended status. You may not",!,"edit the answers.",!! H 3 G EXIT
- S QNUMANS=$P($G(^QA(748.3,FILEDA,0)),U,4) ;number of questions answered
- I +QNUMANS=0 S QLINE=4 X CLEOP1 W !!,*7,"You have not answered any questions on this survey.",!!,"Please use the 'Participate in a Survey' option",!,"instead of this one.",!!,"Press RETURN " R ANS:DTIME G EXIT
- S DMANMSTR=$P(Y(0),U,8) ;are ALL demographics required?
- D ^QAPEDI1
- ;
- EXIT G EXIT^QAPUTIL
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPEDINC 1543 printed Apr 23, 2025@18:52:48 Page 2
- QAPEDINC ;557/THM-EDIT AN INCOMPLETE SURVEY [ 05/31/95 1:32 PM ] ;10/27/95 09:39
- +1 ;;2.0;Survey Generator;**3**;Jun 20, 1995
- +2 ;
- +3 DO SCREEN^QAPUTIL
- EN WRITE @IOF,!
- SET QAPHDR="Edit an Incomplete Survey"
- XECUTE QAPBAR
- +1 WRITE !!,"This option will allow you to edit the answers you have entered on a survey",!,"so far. You must use the 'Participate in a Survey' option to finish it.",!!
- +2 SET DIC="^QA(748,"
- SET DIC(0)="AEQMZ"
- DO ^DIC
- if X=""!(X[U)
- GOTO EXIT
- SET SURVEY=+Y
- +3 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Is this the correct survey"
- DO ^DIR
- if X[U!($DATA(DIRUT))
- GOTO EXIT
- IF Y=0
- GOTO EN
- +4 SET SVSTAT=$PIECE(^QA(748,SURVEY,0),U,4)
- IF SVSTAT'="r"
- WRITE *7,!!,"This survey is not available for selection at this time. Its current",!,"status is ",$SELECT(SVSTAT="d":"Under Maintenance/Development",1:"Active Life Expired"),".",!!
- HANG 3
- GOTO EN
- +5 ;read index backwards to get last response to see if suspended
- +6 SET X="`"_DUZ
- DO HASH^XUSHSHP
- SET USER=X
- SET FILEDA=$ORDER(^QA(748.3,"AC",USER,SURVEY,"zz"),-1)
- IF FILEDA=""
- WRITE *7,!!,"You do not have a response on file for this survey.",!!
- HANG 3
- GOTO EN
- +7 IF $PIECE(^QA(748.3,FILEDA,0),U,3)'="s"
- WRITE *7,!!,"Your response does not have a suspended status. You may not",!,"edit the answers.",!!
- HANG 3
- GOTO EXIT
- +8 ;number of questions answered
- SET QNUMANS=$PIECE($GET(^QA(748.3,FILEDA,0)),U,4)
- +9 IF +QNUMANS=0
- SET QLINE=4
- XECUTE CLEOP1
- WRITE !!,*7,"You have not answered any questions on this survey.",!!,"Please use the 'Participate in a Survey' option",!,"instead of this one.",!!,"Press RETURN "
- READ ANS:DTIME
- GOTO EXIT
- +10 ;are ALL demographics required?
- SET DMANMSTR=$PIECE(Y(0),U,8)
- +11 DO ^QAPEDI1
- +12 ;
- EXIT GOTO EXIT^QAPUTIL
