- 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 Feb 19, 2025@00:04:50 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