source: FOIAVistA/trunk/r/SURVEY_GENERATOR-QAP/QAPQCOPY.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1QAPQCOPY ;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 ;
6EN 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 ;
11START 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 ;
19SEL 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 ;
22QAPQN 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 ;
27QAPQN1 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 ;
33EDIT 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 ;
35EXIT Q ;kill variables in calling program
Note: See TracBrowser for help on using the repository browser.