source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPEDIT1.m@ 1670

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1QAPEDIT1 ;557/THM-CREATE/EDIT/MAINTAIN SURVEY INFORMATION, PART 2 [ 05/18/95 7:28 AM ]
2 ;;2.0;Survey Generator;;Jun 20, 1995
3 ;
4INDIV I $O(^QA(748.3,"B",SURVEY,0))]"" W *7,!!,"This survey has data associated with it and the question content",!,"may not be changed.",!!,"Press RETURN " R ANS:DTIME S:'$T STOP=1 G:$D(STOP) EXIT G EN^QAPEDIT
5 I ACTION="I" K STOP,OUT S DA(1)=SURVEY DO G:$D(STOP) EXIT
6 .;
7DIS .K DA S DA(1)=SURVEY
8 .K DANS S LSTNUM="" F I=0:0 S I=$O(^QA(748.25,"E",SURVEY,I)) Q:I="" F J=0:0 S J=$O(^QA(748.25,"E",SURVEY,I,J)) Q:J="" S DANS(I,J)=I,DANS(I)=I,LSTNUM=I
9 .W @IOF,! S QAPHDR="Survey Name: "_SUBJ X QAPBAR S QAPHDR="Editing Individual Questions" X QAPBAR W !,BLDON,"Type ^ to exit, ? or ?? for HELP",BLDOFF
10 .W:$D(LSTNUM) ?51,"Last question number: ",LSTNUM W !!,">> Question number: " R QAPQN:DTIME S:+QAPQN>0 LSTNUM=QAPQN I '$T S STOP=1 Q
11 .I QAPQN="?" D HELPLKE^QAPUTIL1 I QAPQN="" G DIS
12 .I QAPQN=""!(QAPQN[U) S OUT=1 Q
13 .S QAPQN=$TR(QAPQN,"cr","CR")
14 .I QAPQN?1"R" W " Resequence question numbers " H 1 D R1^QAPRSEQ G DIS
15 .I QAPQN?1"C" D EN^QAPQCOPY,RSQ G DIS
16 .I QAPQN'?1.3N,QAPQN'?1.3N1"."1.2N,QAPQN'?1"R",+QAPQN'=QAPQN W !!,"Question number entry must be numeric,'R' to resequence",!,"the question numbers, or 'C' to copy a question.",*7 H 2 G DIS
17 .I +QAPQN<1!(+QAPQN>999) W !!,*7,"This number must be between 1 and 999.",! H 2 G DIS
18 .S (DIC,DIE)="^QA(748.25,"_DA(1)_",1," X CLEOP
19 .S DA=$O(^QA(748.25,"E",DA(1),QAPQN,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,!
20 .K DIR S DIR("A")="Change or Delete"
21 .I DA]"" S DIR(0)="SB^C:Change;D:Delete",DIR("B")="Change" D ^DIR S:$D(DTOUT) EXIT=1 S:$D(DUOUT) OUT=1 Q:$D(DTOUT) G:$D(DUOUT) DIS S CHOICE=Y I CHOICE=""!(CHOICE[U) S OUT=1 Q
22 .I DA="" K DIR,STOP,OUT S DIR("A")="Are you adding question "_QAPQN_" ",DIR(0)="Y",DIR("B")="No" W *7 D ^DIR S:$D(DTOUT) EXIT=1 S:$D(DUOUT) OUT=1 Q:$D(DTOUT)!($D(DUOUT)) S:Y=1 CHOICE="A" I Y'=1 G DIS
23 .I CHOICE="A" S:'$D(^QA(748.25,DA(1),1,0)) ^QA(748.25,DA(1),1,0)="^748.26I^0^0"
24 .I CHOICE="A" S X=+$P(^QA(748.25,DA(1),1,0),U,3)+1,DLAYGO=748.25,DIC(0)="AEQLM",DIC("DR")=".015////"_QAPQN_";.055;.05;.02" K DO,DD D FILE^DICN
25 .I CHOICE="A" Q:+Y<0 S DA=+Y I $P(^QA(748.25,DA(1),1,DA,1),U)="m" S DR=".025;I X'=""l"" S Y=""@1"";.027;3;1;2;S Y=""@99"";@1;.03;@99" D ^DIE,RSQ
26 .I CHOICE="C" S DR=".015;.055;.05;.02" X CLEOP D ^DIE,RSQ S:$D(DTOUT) STOP=1 G:$D(Y) DIS
27 .I CHOICE="C",$P(^QA(748.25,DA(1),1,DA,1),U)'="m" D KANS^QAPUTIL2 S DR=".025///@;.027///@;3///@;1///@;2///@" D ^DIE,RSQ
28 .I CHOICE="C",$P(^QA(748.25,DA(1),1,DA,1),U)="m" S DR=".025;I X'=""l"" S Y=""@1"";D KANS^QAPUTIL2;.027;3;1;2;S Y=""@99"";@1;.027///@;3///@;1///@;2///@;.03;@99" D ^DIE,RSQ
29 .I CHOICE="D" DO G DIS
30 ..W !,*7,"Are you sure you want to remove this question" S %=2 D YN^DICN I $D(DTOUT) S EXIT=1 Q
31 ..I %'=1 W !,">> Nothing deleted <<" H 1 Q
32 ..I %=1 S DIK="^QA(748.25,"_DA(1)_",1," D ^DIK W !!,">> Question removed << " H 2 Q
33 .G DIS
34 ;
35EDITALL I $O(^QA(748.3,"B",SURVEY,0))]"" W *7,!!,"This survey has data associated with it and the question content",!,"may not be changed.",! H 2 G EN^QAPEDIT
36 S DA(1)=SURVEY
37 I ACTION="E" K OUT S QAPHDR="Survey Name: "_SUBJ W @IOF,! X QAPBAR S QAPHDR="Edit All Questions Sequentially" X QAPBAR K ^TMP($J)
38 I ACTION="E",$O(^QA(748.25,"E",SURVEY,0))="" W !!?10,"This survey has no questions.",! H 2 G EN^QAPEDIT
39 I ACTION="E" F QAPQN=0:0 S QAPQN=$O(^QA(748.25,"E",DA(1),QAPQN)) Q:QAPQN="" F DA=0:0 S DA=$O(^QA(748.25,"E",DA(1),QAPQN,DA)) Q:DA="" DO I $D(OUT)!($D(EXIT)) S (QAPQN,DA,DA(1))=999999
40 .S QAPHDR="Survey Name: "_SUBJ W @IOF,! X QAPBAR S QAPHDR="Edit All Questions Sequentially" X QAPBAR
41 .W !,">> Question number: ",QAPQN,! S (DIC,DIE)="^QA(748.25,"_DA(1)_",1,",DR=".055;.05;.015;.02" D ^DIE,RSQ I $D(DTOUT) S EXIT=1 Q
42 .I $D(Y) S OUT=1 Q
43 .I $P(^QA(748.25,DA(1),1,DA,1),U)'="m" D KANS^QAPUTIL2 S DR=".025///@;.027///@;3///@;1///@;2///@" D ^DIE,RSQ
44 .I $P(^QA(748.25,DA(1),1,DA,1),U)="m" S DR=".025;I X'=""l"" S Y=""@1"";D KANS^QAPUTIL2;.027;3;1;2;S Y=""@99"";@1;.027///@;3///@;1///@;2///@;.03;@99" D ^DIE,RSQ I $D(DTOUT) S EXIT=1 Q
45 .I $D(Y) S OUT=1 Q
46 I $D(EXIT) G EXIT
47 G EN^QAPEDIT
48 ;
49EXIT G EXIT^QAPUTIL
50 ;
51RSQ K DANS F I=0:0 S I=$O(^QA(748.25,"E",SURVEY,I)) Q:I="" F J=0:0 S J=$O(^QA(748.25,"E",SURVEY,I,J)) Q:J="" S DANS(I,J)=I,DANS(I)=I
52 Q
Note: See TracBrowser for help on using the repository browser.