QAPEDINC.m

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 ---QAPEDINC   1543     printed  Apr 09, 2024@21:40:56                                                                                                                                                                                                    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