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 ---[H[J[2J[HQAPFIX 1598 printed Nov 22, 2024@17:48:18 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
