QAPFIX.m

QAPFIX ;557/THM-FIX A HUNG SURVEY RESPONSE [ 03/13/95  7:03 PM ]

 ;;2.0;Survey Generator;;Jun 20, 1995

 D DT^DICRW S IOP="HOME" D ^%ZIS

 D SCREEN^QAPUTIL

EN S QAPHDR="Fix a Survey Response" W @IOF,! X QAPBAR

 W !!,"This option fixes a participant's survey response that may still",!,"show as ""in progress"" due to having exited abnormally or the job",!,"having been killed.",!!

 S DIC=748,DIC(0)="QEAM",DIC("A")="Select SURVEY: " D ^DIC G:X=""!($D(DTOUT))!(X[U) EXIT

 K DIC S SURVEY=+Y,SNAME=$P(^QA(748,SURVEY,0),U,1) H 1

 ;

SEL K QLINE S QAPHDR="Fix Response for "_SNAME W @IOF,! X QAPBAR W !!

 S DIC("A")="Select RESPONDANT: ",DIC=200,DIC(0)="QEAM" D ^DIC G:X=""!($D(DTOUT))!(X[U) EXIT

 K DIC S (USER,X)=+Y D HASH^XUSHSHP S QAPUSER=X

 W @IOF,! X QAPBAR W !!,"Survey: ",SNAME,!,"Respondant: ",$P(^VA(200,USER,0),U,1),!! S QLINE=$Y-1

CORR W "Is everything correct" S %=2 D YN^DICN G:$D(DTOUT) EXIT

 I $D(%Y),%Y["?" W !!,"Enter Y if the correct person or N if not.  " H 3 X CLEOP1 G CORR

 I $D(%),%'=1 G EN

 ;read backwards to get last participation record

 S DA=$O(^QA(748.3,"AC",QAPUSER,SURVEY,"zz"),-1) I DA="" W *7,!!,"No response found for this participant.",!! H 3 G SEL

 I $P(^QA(748.3,DA,0),U,3)'="i" W !!,"There is no response on file for this participant which",!,"needs to be fixed.",!!,*7,"Press RETURN  " R ANS:DTIME G:'$T EXIT G SEL

 ;

FIX S (QAPCNT,CQUES)=+$P($G(^QA(748.3,DA,1,0)),U,4) ;read global for count

 S (DIC,DIE)="^QA(748.3,",DR="3////s;4////"_QAPCNT_";5////"_CQUES D ^DIE W !!,"Response fixed." H 1 G EN

 ;

EXIT K USER,QAPUSER,SNAME G EXIT^QAPUTIL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAPFIX   1598     printed  Apr 09, 2024@21:41:01                                                                                                                                                                                                      Page 2

QAPFIX    ;557/THM-FIX A HUNG SURVEY RESPONSE [ 03/13/95  7:03 PM ]

 +1       ;;2.0;Survey Generator;;Jun 20, 1995

 +2        DO DT^DICRW

           SET IOP="HOME"

           DO ^%ZIS

 +3        DO SCREEN^QAPUTIL

EN         SET QAPHDR="Fix a Survey Response"

           WRITE @IOF,!

           XECUTE QAPBAR

 +1        WRITE !!,"This option fixes a participant's survey response that may still",!,"show as ""in progress"" due to having exited abnormally or the job",!,"having been killed.",!!

 +2        SET DIC=748

           SET DIC(0)="QEAM"

           SET DIC("A")="Select SURVEY: "

           DO ^DIC

           if X=""!($DATA(DTOUT))!(X[U)

               GOTO EXIT

 +3        KILL DIC

           SET SURVEY=+Y

           SET SNAME=$PIECE(^QA(748,SURVEY,0),U,1)

           HANG 1

 +4       ;

SEL        KILL QLINE

           SET QAPHDR="Fix Response for "_SNAME

           WRITE @IOF,!

           XECUTE QAPBAR

           WRITE !!

 +1        SET DIC("A")="Select RESPONDANT: "

           SET DIC=200

           SET DIC(0)="QEAM"

           DO ^DIC

           if X=""!($DATA(DTOUT))!(X[U)

               GOTO EXIT

 +2        KILL DIC

           SET (USER,X)=+Y

           DO HASH^XUSHSHP

           SET QAPUSER=X

 +3        WRITE @IOF,!

           XECUTE QAPBAR

           WRITE !!,"Survey: ",SNAME,!,"Respondant: ",$PIECE(^VA(200,USER,0),U,1),!!

           SET QLINE=$Y-1

CORR       WRITE "Is everything correct"

           SET %=2

           DO YN^DICN

           if $DATA(DTOUT)

               GOTO EXIT

 +1        IF $DATA(%Y)

               IF %Y["?"

                   WRITE !!,"Enter Y if the correct person or N if not.  "

                   HANG 3

                   XECUTE CLEOP1

                   GOTO CORR

 +2        IF $DATA(%)

               IF %'=1

                   GOTO EN

 +3       ;read backwards to get last participation record

 +4        SET DA=$ORDER(^QA(748.3,"AC",QAPUSER,SURVEY,"zz"),-1)

           IF DA=""

               WRITE *7,!!,"No response found for this participant.",!!

               HANG 3

               GOTO SEL

 +5        IF $PIECE(^QA(748.3,DA,0),U,3)'="i"

               WRITE !!,"There is no response on file for this participant which",!,"needs to be fixed.",!!,*7,"Press RETURN  "

               READ ANS:DTIME

               if '$TEST

                   GOTO EXIT

               GOTO SEL

 +6       ;

FIX       ;read global for count

           SET (QAPCNT,CQUES)=+$PIECE($GET(^QA(748.3,DA,1,0)),U,4)

 +1        SET (DIC,DIE)="^QA(748.3,"

           SET DR="3////s;4////"_QAPCNT_";5////"_CQUES

           DO ^DIE

           WRITE !!,"Response fixed."

           HANG 1

           GOTO EN

 +2       ;

EXIT       KILL USER,QAPUSER,SNAME

           GOTO EXIT^QAPUTIL