source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPSCRN.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1QAPSCRN ;557/THM-USER INPUT FOR SURVEYS [ 07/07/95 9:27 AM ]
2 ;;2.0;Survey Generator;;Jun 20, 1995
3 ;
4 D SCREEN^QAPUTIL S X="TRAP^QAPUTIL2",@^%ZOSF("TRAP")
5EN S QAPOUT=0,MSSG=">> Question skipped <<",MSSG0="W *7,!!,?(IOM-$L(MSSG)\2),MSSG"
6 W @IOF,! S QAPHDR="Survey Data Entry" X QAPBAR
7 ;DIC("S") screens out all but "ready for use" statuses
8 K DIC S DIC="^QA(748,",DIC(0)="AEQMZ",DIC("A")="Select a survey: ",DIC("S")="I $P(^(0),U,4)=""r""" D ^DIC K DIC G:X=""!(X[U) QUIT^QAPSCRN1
9 ;change status automatically when expired
10 S LASTDATE=$P(Y(0),U,3) I LASTDATE]"",DT>LASTDATE W *7,!!,"This survey is no longer active.",!! S:$P(Y(0),U,4)'="d" $P(^QA(748,+Y,0),U,4)="e" H 2 G EN
11 ;
12CONT S SURVEY=+Y,QAPNAME=$P(Y(0),U),TITLE=$P(Y(0),U,6),X="`"_DUZ D HASH^XUSHSHP S USER=X
13 S DMANMSTR=$P(Y(0),U,8) ;are ALL demographics required?
14 S (SVST,LQUES)="" K IFN,QUIT
15 ;find any suspended response
16 F DA=0:0 S DA=$O(^QA(748.3,"AC",USER,SURVEY,DA)) Q:DA=""!($D(QUIT)) I $P(^QA(748.3,DA,0),U,3)="s" S IFN=DA S QUIT=1 Q
17 ;if no suspended response, see if one completed
18 K DA,QUIT I '$D(IFN) S IFN=$O(^QA(748.3,"AC",USER,SURVEY,0))
19 I IFN]"" S X=$G(^QA(748.3,IFN,0)),SVST=$P(X,U,3),LQUES=$P(X,U,4),LORD=+$P(X,U,5) I +LQUES=0 S LQUES="<no questions answered>"
20 S CNT=0,PASSX=$P(Y(0),U,9) ;for multi-participation
21 S PASSX=$TR(PASSX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
22 W @IOF,! X QAPBAR S QAPHDR="Survey: "_TITLE X QAPBAR W !! S QLINE=$Y X CLEOP1
23 I SVST="c",PASSX="" W !!,*7,"You may not participate more than once in this survey.",!!,"Press RETURN " R ANS:DTIME G EXIT^QAPUTIL
24 I SVST="c",PASSX]"" W !!,*7,"You have already taken and completed this survey.",!,"You may participate again only if you know the correct password.",!!
25 I PASSX=""!(SVST'="c") G PASSN
26 S QLINE=$Y-1
27PASSM X ^%ZOSF("EOFF")
28 W BLDON,"Enter ^ to exit",BLDOFF W !!
29 W "Enter MULTI-PARTICIPATION PASSWORD: " R X:DTIME G:'$T!(X[U) QUIT^QAPSCRN1
30 S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
31 I X'=PASSX W *7,!!,"Incorrect password " H 2 S CNT=CNT+1 X CLEOP1
32 I X=PASSX G STR1
33 I CNT>2 W !!,*7,"You don't know the password !",! X ^%ZOSF("EON") H 2 G QUIT^QAPSCRN1
34 I PASSX]"",X'=PASSX G PASSM
35 ;
36PASSN I SVST="s" W !!,"This is a restart of a previous session.",!,"The last question answered was # ",LQUES,".",!!,"Press RETURN " R ANS:DTIME G:'$T!(ANS[U) QUIT^QAPSCRN1
37 I SVST="s" S:LORD=99999 LORD=0 S (DISP,CQUES)=LORD,QAPCNT=+LQUES G HELPINS
38 I SVST="i" W !!,"You appear to be already working on this survey at another terminal.",!! H 3 G QUIT^QAPSCRN1
39 S CNT=0,PASSX=$P(Y(0),U,7)
40 ;
41PASSR I PASSX="" G STR1
42 S PASSX=$P(Y(0),U,7) X ^%ZOSF("EOFF") X CLEOP W !,"Enter SURVEY PASSWORD: " R X:DTIME G:'$T!(X[U) QUIT^QAPSCRN1
43 S PASSX=$TR(PASSX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
44 S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
45 I X'=PASSX W *7,!!,"Incorrect password " H 2 S CNT=CNT+1
46 I X=PASSX G STR1
47 I CNT>2 W !!,*7,"You do not know the password !",! X ^%ZOSF("EON") H 2 G QUIT^QAPSCRN1
48 I PASSX]"",X'=PASSX G PASSR
49 ;
50STR1 K NEWREC X ^%ZOSF("EON") S (DIC,DIE)="^QA(748.3,",DLAYGO=748.3,DIC(0)="LM",X=SURVEY,DIC("DR")="2///^S X=""`""_DUZ" K DO,DD D FILE^DICN S FILEDA=+Y K DIC,DO,X,Y,DLAYGO,DA S NEWREC=1 ;must use /// to force encryption of DUZ via input xform
51 S (DISP,QUES)=""
52 ;
53HELPINS G:+LQUES>0 EN1^QAPSCRN1 S QLINE=4 X CLEOP1 W !!,"Do you want to see instructions" S %=1 D YN^DICN I %=1 X CLEOP D INSTRUCT^QAPUTIL W !!,"Press RETURN " R ANS:DTIME K ANS I '$T S DSTOP=1 G KILL^QAPSCRN1
54 I $D(DTOUT) S DSTOP=1 K EDIT G KILL^QAPSCRN1
55 I $D(%Y),%Y["?" W !!,"Enter Y to see instructions or N to skip them. " H 3 X CLEOP1 W ! G HELPINS
56 I %<1,$D(NEWREC) D ABORT^QAPSCRN1 G:$D(STOP) QUIT^QAPSCRN1
57 I %<1,'$D(NEWREC) G QUIT^QAPSCRN1
58 ;
59 G EN1^QAPSCRN1
Note: See TracBrowser for help on using the repository browser.