source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPFIX.m@ 1593

Last change on this file since 1593 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1QAPFIX ;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
5EN 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 ;
10SEL 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
14CORR 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 ;
21FIX 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 ;
24EXIT K USER,QAPUSER,SNAME G EXIT^QAPUTIL
Note: See TracBrowser for help on using the repository browser.