- 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 Jan 18, 2025@03:39:45 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