| 1 | QAPADD ;557/THM-CREATE A NEW SURVEY, PART 1 [ 05/18/95 7:03 AM ]
|
|---|
| 2 | ;;2.0;Survey Generator;;Jun 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ;called by QAPEDIT
|
|---|
| 5 | Q ;enter properly
|
|---|
| 6 | DV I $D(DUZ(2))#2=0 W !!,*7,"You do not have a division defined.",!! H 2 Q
|
|---|
| 7 | I +DUZ(2)=0 W !!,*7,"Your division is incorrect.",!! H 2 Q
|
|---|
| 8 | ;
|
|---|
| 9 | EN W @IOF,! S QAPHDR="Create a New Survey",QAPOUT=0 X QAPBAR
|
|---|
| 10 | S DIC("DR")=".055////"_DUZ,DIC="^QA(748,",DIC(0)="AEQMLZ",DIC("A")="Survey NAME: " X CLEOP D ^DIC S:$D(DTOUT) STOP=1 S:X=""!(X[U) QAPOUT=1 I $D(DTOUT)!(QAPOUT=1) K X,Y Q
|
|---|
| 11 | S SURVEY=+Y I $P(Y,U,3)'=1 W *7,!!,"This is not a new survey.",!,"Please use the edit feature for any changes.",! H 2 G EN
|
|---|
| 12 | ;
|
|---|
| 13 | K EDIT
|
|---|
| 14 | EN1 K DIR,OUT,STOP,DIC,DIE,DR
|
|---|
| 15 | S SUBJ=$P(^QA(748,SURVEY,0),U) X CLEOP
|
|---|
| 16 | S DA=SURVEY,DIC="^QA(748,",DR=".02////"_$P(^DIC(4,DUZ(2),99),U,1)_";.01;.015;.03;.04;4;.05////d;.08;.1;5;1;2"
|
|---|
| 17 | S DIE=DIC D ^DIE D:'$D(Y) S:'$D(Y) EDIT=1 I $D(DTOUT) S STOP=1 Q
|
|---|
| 18 | .W !! I $O(^QA(748,DA,2,0))="" W !,*7,"Note: The survey description was not entered !",! H 2
|
|---|
| 19 | .I $O(^QA(748,DA,4,0))="" W *7,"Note: The survey instructions were not entered !",! H 2
|
|---|
| 20 | ;
|
|---|
| 21 | DEL K %,%Y I $D(Y),'$D(EDIT) W *7,!!,"Do you really want to delete this survey" S %=2 D YN^DICN I $D(DTOUT) S STOP=1 Q
|
|---|
| 22 | I $D(%Y),%Y["?" W !!,"If you answer Y you will have to re-enter the survey information.",!,"If you answer N you will return to editing.",!
|
|---|
| 23 | I $D(%) G:%'=1 EN1 S DA=SURVEY,DIK="^QA(748," D ^DIK W !!,">> Survey deleted <<",! H 2 G EN
|
|---|
| 24 | ;
|
|---|
| 25 | REDIT K STOP,DTOUT,DUOUT W @IOF,! X QAPBAR W !!,"Do you wish to edit any of this basic information" S %=2 D YN^DICN S:$D(DTOUT) STOP=1 Q:$D(STOP) I %=1 W @IOF,! X QAPBAR G EN1
|
|---|
| 26 | I $D(%Y),%Y["?" W !!,"Enter Y to edit this information or N to proceed.",! H 2 G REDIT
|
|---|
| 27 | I $D(%),%=-1 DO G:'$D(STOP) REDIT G:$D(STOP) EXIT^QAPUTIL
|
|---|
| 28 | .S QLINE=3 X CLEOP1
|
|---|
| 29 | .W !,*7,"You have entered ""^"" to interrupt entry of this survey.",!
|
|---|
| 30 | .W !!,"If you stop now, you have not entered demographics or questions and the",!,"survey is incomplete. It is not possible to delete the survey from",!
|
|---|
| 31 | .W "this point in this option. You will have to use the menu option",!,BLDON,"Delete a Survey, Questions and Responses",BLDOFF,".",!
|
|---|
| 32 | .;
|
|---|
| 33 | STOP .W !,"Is this what you really want to do" S %=2 D YN^DICN I %=1!($D(DTOUT)) S STOP=1
|
|---|
| 34 | .I $D(%Y),%Y["?" W !!,"Enter Y to stop or N to begin the editing again.",! H 2 G STOP
|
|---|
| 35 | D EN^QAPDEM ;do not allow ^ abort-incomplete record would be generated.
|
|---|
| 36 | S (X,DINUM)=SURVEY,DIC(0)="QM",(DIC,DIE)="^QA(748.25," K DO,DD D FILE^DICN K DINUM
|
|---|
| 37 | G ^QAPADD1
|
|---|
