source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPUTIL1.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1QAPUTIL1 ;557/THM-SURVEY GENERATOR UTILITIES, PART 2 [ 06/01/95 10:32 AM ]
2 ;;2.0;Survey Generator;;Jun 20, 1995
3 ;
4HELP ;Help on question entry for creators
5 X:$D(CLEOP) CLEOP
6 W !,"This area allows you to enter individual questions to this newly",!,"created survey.",!!
7 W "You will be asked to give an ",BLDON,"increment",BLDOFF," or a number to skip",!,"between each question. It may be any non-decimal number up",!,"to 99.",!!
8 W "You will be asked to give a ",BLDON,"question number",BLDOFF," for each question. The",!,"system will use these numbers in all displays of question data.",!!
9 W "A default starting question number will be supplied and will always",!
10 W "be your increment, but you may override it if you wish. From",!
11 W "then on, the number displayed will be the first number entered",!
12 W "plus your designated increment.",!!
13 W !!,"Press RETURN " R ANS:DTIME I '$T S STOP=1 Q
14 X:$D(CLEOP) CLEOP
15 Q
16 ;
17HELPLK ;display survey questions on user ??
18 W ! K ANSX,STOP,FND X:$D(CLEOP) CLEOP S QAPOUT=0,CNT=0,QAPQN=""
19 W ?2,"Question",!?2,"number",?13,"Q u e s t i o n t e x t",!?2,"-------",?13,"--------------------------------------------------------------",!!
20 S SQUEST=$O(DANS(0)),CNTPG=0
21 F I=0:0 S I=$O(DANS(I)) Q:I=""!(QAPOUT=1)!($D(FND))!(CNT=QNUMANS) F J=0:0 S J=$O(DANS(I,J)) Q:J=""!(QAPOUT=1)!($D(FND))!(CNT=QNUMANS) DO
22 .S CNT=CNT+1
23 .W ?5,I,?13,$S($G(^QA(748.25,SURVEY,1,J,2,1,0))]"":$E(^(0),1,55),1:"No text"),! S CNTPG=CNTPG+1 ;# displayed this page
24SEL .S QAPOUT=0
25 .I $O(DANS(I))=""!((CNT#10)=0)!(J=QNUMANS) DO
26 ..S QLINE=8 W !,"Select a question from ",SQUEST," to ",I,", enter '^' or RETURN to go back",!,"to the previous prompt: " R ANSX:DTIME S:'$T STOP=1 S:ANSX[U QAPOUT=1 Q:$D(STOP)
27 ..X:ANSX=""&($D(CLEOP1)) CLEOP1 S:ANSX="" CNTPG=0 Q:ANSX[U!(ANSX="")
28 ..I ANSX'=U,ANSX'="",ANSX'?1.3N,ANSX'?1.3N1"."1.3N S ANSX="ZZ",(CNT,CNTPG)=0
29 ..D:'$D(DANS(+ANSX)) S:'$D(DANS(+ANSX)) QAPNOANS=1 Q:$D(QAPNOANS) I $D(DANS(+ANSX)) S QAPQN=DANS(+ANSX),FND=1 Q
30 ...X:$D(CLEOP1) CLEOP1 W *7,"You must select ",SQUEST," to ",I," enter '^' or RETURN",!,"to go back to the previous prompt. " H 2 X CLEOP1
31 ...S I=(CNT-CNTPG),I=I-CNTPG,CNT=CNT-(CNTPG),CNTPG=0
32 ...S:I<10 I=0 S:CNT<10 CNT=0
33 . I $D(QAPNOANS) K QAPNOANS Q
34 .I $D(ANSX) I ANSX[U S QAPOUT=1 Q
35 K FND,CNT,SQUEST S QAPOUT=0
36 Q
37 ;
38HELPLKE ;display questions - creator edit
39 W ! K ANSX,STOP,FND X:$D(CLEOP) CLEOP S QAPOUT=0,CNT=0,QAPQN=""
40 W ?2,"Question",!?2,"number",?13,"Q u e s t i o n t e x t",!?2,"-------",?13,"--------------------------------------------------------------",!!
41 S SQUEST=$O(DANS(0)),CNTPG=0
42 I SQUEST="" W !!?10,"This survey does not yet have questions.",! H 2 Q
43 F I=0:0 S I=$O(DANS(I)) Q:I=""!(QAPOUT=1)!($D(FND)) F J=0:0 S J=$O(DANS(I,J)) Q:J=""!(QAPOUT=1)!($D(FND)) DO
44 .S CNT=CNT+1
45 .W ?5,I,?13,$S($G(^QA(748.25,SURVEY,1,J,2,1,0))]"":$E(^(0),1,55),1:"No text"),! S CNTPG=CNTPG+1
46SELA .S QAPOUT=0
47 .I $O(^QA(748.25,"E",SURVEY,I))=""!((CNT#10)=0) DO
48 ..S QLINE=8 W !,"Select a question from ",SQUEST," to ",I,", enter '^' or RETURN to go back",!,"to the previous prompt: " R ANSX:DTIME S:'$T (STOP,QAPOUT)=1 Q:$D(STOP)
49 ..I ANSX'=U,ANSX'="",ANSX'?1.3N,ANSX'?1.3N1"."1.3N S ANSX="ZZ",(CNT,CNTPG)=0
50 ..X:ANSX=""&($D(CLEOP1)) CLEOP1 S:ANSX="" CNTPG=0 Q:ANSX[U!(ANSX="")
51 ..D:'$D(DANS(+ANSX)) S:'$D(DANS(+ANSX)) QAPNOANS=1 Q:$D(QAPNOANS) I $D(DANS(+ANSX)) S QAPQN=DANS(+ANSX),FND=1 Q
52 ...X:$D(CLEOP1) CLEOP1 W *7,"You may select only from ",SQUEST," to ",I," enter '^' or RETURN",!,"to go back to the previous prompt. " H 3 X CLEOP1
53 ...S I=(CNT-CNTPG),CNT=CNT-(CNTPG),CNTPG=0
54 ...S:I<10 I=0 S:CNT<0 CNT=10
55 . I $D(QAPNOANS) K QAPNOANS Q
56 .I $D(ANSX) I ANSX[U S QAPOUT=1 Q
57 K FND,CNT,SQUEST S QAPOUT=0
58 Q
Note: See TracBrowser for help on using the repository browser.