QAPUTIL1 ;557/THM-SURVEY GENERATOR UTILITIES, PART 2 [ 06/01/95 10:32 AM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
HELP ;Help on question entry for creators
X:$D(CLEOP) CLEOP
W !,"This area allows you to enter individual questions to this newly",!,"created survey.",!!
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.",!!
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.",!!
W "A default starting question number will be supplied and will always",!
W "be your increment, but you may override it if you wish. From",!
W "then on, the number displayed will be the first number entered",!
W "plus your designated increment.",!!
W !!,"Press RETURN " R ANS:DTIME I '$T S STOP=1 Q
X:$D(CLEOP) CLEOP
Q
;
HELPLK ;display survey questions on user ??
W ! K ANSX,STOP,FND X:$D(CLEOP) CLEOP S QAPOUT=0,CNT=0,QAPQN=""
W ?2,"Question",!?2,"number",?13,"Q u e s t i o n t e x t",!?2,"-------",?13,"--------------------------------------------------------------",!!
S SQUEST=$O(DANS(0)),CNTPG=0
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
.S CNT=CNT+1
.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
SEL .S QAPOUT=0
.I $O(DANS(I))=""!((CNT#10)=0)!(J=QNUMANS) DO
..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)
..X:ANSX=""&($D(CLEOP1)) CLEOP1 S:ANSX="" CNTPG=0 Q:ANSX[U!(ANSX="")
..I ANSX'=U,ANSX'="",ANSX'?1.3N,ANSX'?1.3N1"."1.3N S ANSX="ZZ",(CNT,CNTPG)=0
..D:'$D(DANS(+ANSX)) S:'$D(DANS(+ANSX)) QAPNOANS=1 Q:$D(QAPNOANS) I $D(DANS(+ANSX)) S QAPQN=DANS(+ANSX),FND=1 Q
...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
...S I=(CNT-CNTPG),I=I-CNTPG,CNT=CNT-(CNTPG),CNTPG=0
...S:I<10 I=0 S:CNT<10 CNT=0
. I $D(QAPNOANS) K QAPNOANS Q
.I $D(ANSX) I ANSX[U S QAPOUT=1 Q
K FND,CNT,SQUEST S QAPOUT=0
Q
;
HELPLKE ;display questions - creator edit
W ! K ANSX,STOP,FND X:$D(CLEOP) CLEOP S QAPOUT=0,CNT=0,QAPQN=""
W ?2,"Question",!?2,"number",?13,"Q u e s t i o n t e x t",!?2,"-------",?13,"--------------------------------------------------------------",!!
S SQUEST=$O(DANS(0)),CNTPG=0
I SQUEST="" W !!?10,"This survey does not yet have questions.",! H 2 Q
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
.S CNT=CNT+1
.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
SELA .S QAPOUT=0
.I $O(^QA(748.25,"E",SURVEY,I))=""!((CNT#10)=0) DO
..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)
..I ANSX'=U,ANSX'="",ANSX'?1.3N,ANSX'?1.3N1"."1.3N S ANSX="ZZ",(CNT,CNTPG)=0
..X:ANSX=""&($D(CLEOP1)) CLEOP1 S:ANSX="" CNTPG=0 Q:ANSX[U!(ANSX="")
..D:'$D(DANS(+ANSX)) S:'$D(DANS(+ANSX)) QAPNOANS=1 Q:$D(QAPNOANS) I $D(DANS(+ANSX)) S QAPQN=DANS(+ANSX),FND=1 Q
...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
...S I=(CNT-CNTPG),CNT=CNT-(CNTPG),CNTPG=0
...S:I<10 I=0 S:CNT<0 CNT=10
. I $D(QAPNOANS) K QAPNOANS Q
.I $D(ANSX) I ANSX[U S QAPOUT=1 Q
K FND,CNT,SQUEST S QAPOUT=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPUTIL1 3790 printed Dec 13, 2024@02:38:38 Page 2
QAPUTIL1 ;557/THM-SURVEY GENERATOR UTILITIES, PART 2 [ 06/01/95 10:32 AM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
HELP ;Help on question entry for creators
+1 if $DATA(CLEOP)
XECUTE CLEOP
+2 WRITE !,"This area allows you to enter individual questions to this newly",!,"created survey.",!!
+3 WRITE "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.",!!
+4 WRITE "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.",!!
+5 WRITE "A default starting question number will be supplied and will always",!
+6 WRITE "be your increment, but you may override it if you wish. From",!
+7 WRITE "then on, the number displayed will be the first number entered",!
+8 WRITE "plus your designated increment.",!!
+9 WRITE !!,"Press RETURN "
READ ANS:DTIME
IF '$TEST
SET STOP=1
QUIT
+10 if $DATA(CLEOP)
XECUTE CLEOP
+11 QUIT
+12 ;
HELPLK ;display survey questions on user ??
+1 WRITE !
KILL ANSX,STOP,FND
if $DATA(CLEOP)
XECUTE CLEOP
SET QAPOUT=0
SET CNT=0
SET QAPQN=""
+2 WRITE ?2,"Question",!?2,"number",?13,"Q u e s t i o n t e x t",!?2,"-------",?13,"--------------------------------------------------------------",!!
+3 SET SQUEST=$ORDER(DANS(0))
SET CNTPG=0
+4 FOR I=0:0
SET I=$ORDER(DANS(I))
if I=""!(QAPOUT=1)!($DATA(FND))!(CNT=QNUMANS)
QUIT
FOR J=0:0
SET J=$ORDER(DANS(I,J))
if J=""!(QAPOUT=1)!($DATA(FND))!(CNT=QNUMANS)
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 ;# displayed this page
WRITE ?5,I,?13,$SELECT($GET(^QA(748.25,SURVEY,1,J,2,1,0))]"":$EXTRACT(^(0),1,55),1:"No text"),!
SET CNTPG=CNTPG+1
SEL SET QAPOUT=0
+1 IF $ORDER(DANS(I))=""!((CNT#10)=0)!(J=QNUMANS)
Begin DoDot:2
+2 SET QLINE=8
WRITE !,"Select a question from ",SQUEST," to ",I,", enter '^' or RETURN to go back",!,"to the previous prompt: "
READ ANSX:DTIME
if '$TEST
SET STOP=1
if ANSX[U
SET QAPOUT=1
if $DATA(STOP)
QUIT
+3 if ANSX=""&($DATA(CLEOP1))
XECUTE CLEOP1
if ANSX=""
SET CNTPG=0
if ANSX[U!(ANSX="")
QUIT
+4 IF ANSX'=U
IF ANSX'=""
IF ANSX'?1.3N
IF ANSX'?1.3N1"."1.3N
SET ANSX="ZZ"
SET (CNT,CNTPG)=0
+5 if '$DATA(DANS(+ANSX))
Begin DoDot:3
+6 if $DATA(CLEOP1)
XECUTE CLEOP1
WRITE *7,"You must select ",SQUEST," to ",I," enter '^' or RETURN",!,"to go back to the previous prompt. "
HANG 2
XECUTE CLEOP1
+7 SET I=(CNT-CNTPG)
SET I=I-CNTPG
SET CNT=CNT-(CNTPG)
SET CNTPG=0
+8 if I<10
SET I=0
if CNT<10
SET CNT=0
End DoDot:3
if '$DATA(DANS(+ANSX))
SET QAPNOANS=1
if $DATA(QAPNOANS)
QUIT
IF $DATA(DANS(+ANSX))
SET QAPQN=DANS(+ANSX)
SET FND=1
QUIT
End DoDot:2
+9 IF $DATA(QAPNOANS)
KILL QAPNOANS
QUIT
+10 IF $DATA(ANSX)
IF ANSX[U
SET QAPOUT=1
QUIT
End DoDot:1
+11 KILL FND,CNT,SQUEST
SET QAPOUT=0
+12 QUIT
+13 ;
HELPLKE ;display questions - creator edit
+1 WRITE !
KILL ANSX,STOP,FND
if $DATA(CLEOP)
XECUTE CLEOP
SET QAPOUT=0
SET CNT=0
SET QAPQN=""
+2 WRITE ?2,"Question",!?2,"number",?13,"Q u e s t i o n t e x t",!?2,"-------",?13,"--------------------------------------------------------------",!!
+3 SET SQUEST=$ORDER(DANS(0))
SET CNTPG=0
+4 IF SQUEST=""
WRITE !!?10,"This survey does not yet have questions.",!
HANG 2
QUIT
+5 FOR I=0:0
SET I=$ORDER(DANS(I))
if I=""!(QAPOUT=1)!($DATA(FND))
QUIT
FOR J=0:0
SET J=$ORDER(DANS(I,J))
if J=""!(QAPOUT=1)!($DATA(FND))
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
+7 WRITE ?5,I,?13,$SELECT($GET(^QA(748.25,SURVEY,1,J,2,1,0))]"":$EXTRACT(^(0),1,55),1:"No text"),!
SET CNTPG=CNTPG+1
SELA SET QAPOUT=0
+1 IF $ORDER(^QA(748.25,"E",SURVEY,I))=""!((CNT#10)=0)
Begin DoDot:2
+2 SET QLINE=8
WRITE !,"Select a question from ",SQUEST," to ",I,", enter '^' or RETURN to go back",!,"to the previous prompt: "
READ ANSX:DTIME
if '$TEST
SET (STOP,QAPOUT)=1
if $DATA(STOP)
QUIT
+3 IF ANSX'=U
IF ANSX'=""
IF ANSX'?1.3N
IF ANSX'?1.3N1"."1.3N
SET ANSX="ZZ"
SET (CNT,CNTPG)=0
+4 if ANSX=""&($DATA(CLEOP1))
XECUTE CLEOP1
if ANSX=""
SET CNTPG=0
if ANSX[U!(ANSX="")
QUIT
+5 if '$DATA(DANS(+ANSX))
Begin DoDot:3
+6 if $DATA(CLEOP1)
XECUTE CLEOP1
WRITE *7,"You may select only from ",SQUEST," to ",I," enter '^' or RETURN",!,"to go back to the previous prompt. "
HANG 3
XECUTE CLEOP1
+7 SET I=(CNT-CNTPG)
SET CNT=CNT-(CNTPG)
SET CNTPG=0
+8 if I<10
SET I=0
if CNT<0
SET CNT=10
End DoDot:3
if '$DATA(DANS(+ANSX))
SET QAPNOANS=1
if $DATA(QAPNOANS)
QUIT
IF $DATA(DANS(+ANSX))
SET QAPQN=DANS(+ANSX)
SET FND=1
QUIT
End DoDot:2
+9 IF $DATA(QAPNOANS)
KILL QAPNOANS
QUIT
+10 IF $DATA(ANSX)
IF ANSX[U
SET QAPOUT=1
QUIT
End DoDot:1
+11 KILL FND,CNT,SQUEST
SET QAPOUT=0
+12 QUIT
