| 1 | QAPFIX ;557/THM-FIX A HUNG SURVEY RESPONSE [ 03/13/95 7:03 PM ]
|
|---|
| 2 | ;;2.0;Survey Generator;;Jun 20, 1995
|
|---|
| 3 | D DT^DICRW S IOP="HOME" D ^%ZIS
|
|---|
| 4 | D SCREEN^QAPUTIL
|
|---|
| 5 | EN S QAPHDR="Fix a Survey Response" W @IOF,! X QAPBAR
|
|---|
| 6 | 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.",!!
|
|---|
| 7 | S DIC=748,DIC(0)="QEAM",DIC("A")="Select SURVEY: " D ^DIC G:X=""!($D(DTOUT))!(X[U) EXIT
|
|---|
| 8 | K DIC S SURVEY=+Y,SNAME=$P(^QA(748,SURVEY,0),U,1) H 1
|
|---|
| 9 | ;
|
|---|
| 10 | SEL K QLINE S QAPHDR="Fix Response for "_SNAME W @IOF,! X QAPBAR W !!
|
|---|
| 11 | S DIC("A")="Select RESPONDANT: ",DIC=200,DIC(0)="QEAM" D ^DIC G:X=""!($D(DTOUT))!(X[U) EXIT
|
|---|
| 12 | K DIC S (USER,X)=+Y D HASH^XUSHSHP S QAPUSER=X
|
|---|
| 13 | W @IOF,! X QAPBAR W !!,"Survey: ",SNAME,!,"Respondant: ",$P(^VA(200,USER,0),U,1),!! S QLINE=$Y-1
|
|---|
| 14 | CORR W "Is everything correct" S %=2 D YN^DICN G:$D(DTOUT) EXIT
|
|---|
| 15 | I $D(%Y),%Y["?" W !!,"Enter Y if the correct person or N if not. " H 3 X CLEOP1 G CORR
|
|---|
| 16 | I $D(%),%'=1 G EN
|
|---|
| 17 | ;read backwards to get last participation record
|
|---|
| 18 | 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
|
|---|
| 19 | 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
|
|---|
| 20 | ;
|
|---|
| 21 | FIX S (QAPCNT,CQUES)=+$P($G(^QA(748.3,DA,1,0)),U,4) ;read global for count
|
|---|
| 22 | S (DIC,DIE)="^QA(748.3,",DR="3////s;4////"_QAPCNT_";5////"_CQUES D ^DIE W !!,"Response fixed." H 1 G EN
|
|---|
| 23 | ;
|
|---|
| 24 | EXIT K USER,QAPUSER,SNAME G EXIT^QAPUTIL
|
|---|
