| [613] | 1 | QAPQCOPY ;557/THM-COPY SURVEY QUESTIONS [ 06/19/95 2:26 PM ]
|
|---|
| 2 | ;;2.0;Survey Generator;;Jun 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | Q ;enter properly
|
|---|
| 5 | ;
|
|---|
| 6 | EN W " Copy a question " H 1
|
|---|
| 7 | K DIC,DR,DIE,X,Y
|
|---|
| 8 | I $O(^QA(748.25,"E",SURVEY,0))="" W !!,"There are no questions on this survey.",!!,"Press RETURN " R ANS:DTIME S:'$T STOP=1 G EXIT
|
|---|
| 9 | N QAPHDR
|
|---|
| 10 | ;
|
|---|
| 11 | START S QAPOUT=0 W @IOF,! S QAPHDR="Copy Survey Questions" X QAPBAR W !!,"Enter the question number to copy: " R DQUES:DTIME I '$T S STOP=1 G EXIT
|
|---|
| 12 | I DQUES["?" D HELPLKE^QAPUTIL1 I QAPQN]"" S DQUES=QAPQN W @IOF,! X QAPBAR
|
|---|
| 13 | I DQUES[U!(DQUES="")!(QAPQN="")!(QAPQN[U) S QAPOUT=1 G EXIT
|
|---|
| 14 | X CLEOP S DA=$O(^QA(748.25,"E",SURVEY,DQUES,0)) I DA]"" F I=0:0 S I=$O(^QA(748.25,SURVEY,1,DA,2,I)) D:I=""!(+I=0) Q:I=""!(+I=0) S X=$P(^QA(748.25,SURVEY,1,DA,2,I,0),U,1) W X,!
|
|---|
| 15 | I DQUES?1.3N,DA="" W *7,!!,"There is no question number ",DQUES,! H 2 G START
|
|---|
| 16 | I DQUES'?1.3N,DQUES'?1.3N1"."1.2N W !!,*7,"Your entry must be numeric and also an existing question number. " H 3 G START
|
|---|
| 17 | W !! S QLINE=15
|
|---|
| 18 | ;
|
|---|
| 19 | SEL W "Is this correct question" S %=2 D YN^DICN G:%=2 START G:%<0 EXIT
|
|---|
| 20 | I $D(%Y),%Y["?" W *7,!!,"Enter Y to proceed, N to go back and reselect",!,"""^"" to exit",!! H 2 X CLEOP1 G SEL
|
|---|
| 21 | ;
|
|---|
| 22 | QAPQN I $D(NUM) S QAPQN=NUM G QAPQN1
|
|---|
| 23 | S QLINE=4 X CLEOP1 W *7,!,"You must enter a new number for this ",BLDON,"NEW",BLDOFF," question.",!!,"QUESTION NUMBER: ",*7 R QAPQN:DTIME I '$T S STOP=1 Q
|
|---|
| 24 | Q:QAPQN[U I QAPQN'?1.3N!(QAPQN<0)!(QAPQN>999) W !!,*7,"Entry must be 1-3 numbers (1-999) and must be unique. Enter ^ to exit.",! H 2 G QAPQN
|
|---|
| 25 | I $O(^QA(748.25,"E",SURVEY,QAPQN,0))]"",QAPOUT=0 W !!,*7,"You must enter a different question number.",!,"That one has been used." H 3 G QAPQN
|
|---|
| 26 | ;
|
|---|
| 27 | QAPQN1 S X=$P(^QA(748.25,SURVEY,1,0),U,3)+1,DA(1)=SURVEY,DIC(0)="QM",(DIC,DIE)="^QA(748.25,"_SURVEY_",1," K DO,DD D FILE^DICN
|
|---|
| 28 | S XDA=+Y,%X="^QA(748.25,DA(1),1,DA,",%Y="^QA(748.25,DA(1),1,XDA,"
|
|---|
| 29 | D %XY^%RCR N DR S DA(1)=SURVEY,DA=XDA,DR=".015////"_QAPQN,(DIC,DIE)="^QA(748.25,"_DA(1)_",1," D ^DIE ;reset name, set new question number
|
|---|
| 30 | S $P(^QA(748.25,DA(1),1,DA,0),U,1)=DA ;reset .01 for reindex
|
|---|
| 31 | S DIK="^QA(748.25,",DA=SURVEY D IX^DIK W " Copied " H 1 ;reindex entire record
|
|---|
| 32 | ;
|
|---|
| 33 | EDIT W @IOF,! X QAPBAR S (DIE,DIC)="^QA(748.25,DA(1),1,",DA=XDA,DR=".055;.05" W *7,!!,"Now you may edit the question header and text.",!,"The rest of the question definition will remain",!,"the same unless you change it specifically.",!! D ^DIE
|
|---|
| 34 | ;
|
|---|
| 35 | EXIT Q ;kill variables in calling program
|
|---|
