source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPRSEQ.m@ 1259

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1QAPRSEQ ;557/THM-RESEQUENCE SURVEY QUESTION ORDER [ 05/18/95 7:42 AM ]
2 ;;2.0;Survey Generator;;Jun 20, 1995
3 ;
4 Q ;enter properly
5EN1 X CLEOP1 I $O(^QA(748.25,"E",SURVEY,0))="" W !!,*7,"There are no questions to resequence " H 2 G EXIT
6 W !!,"What increment would you like to use? 1// " R INCREM:DTIME G:'$T!(INCREM[U) EXIT
7 S:INCREM="" INCREM=1 I INCREM<1!(INCREM>10) W !!,*7,"Enter the value to skip between question numbers (1-10).",!! H 2 G EN1
8 I INCREM'?1.2N W !!,*7,"The increment must be 1-2 numbers, without decimals.",!! H 2 G EN1 ;force non-decimal numbers for resequencing
9 W @IOF,! X QAPBAR W !!,"Selected parameters:",!!!,"Survey name: ",SVYNAME,!?2,"Increment: ",INCREM,!! K DIR S DIR("A")="Is this Ok",DIR("B")="NO",DIR(0)="Y" D ^DIR G:Y'=1 EN1
10 ;
11RGO K ^TMP($J) S NINCREM=0 W !!
12 ;write to ^TMP($J to avoid editing problems when index changes
13 F QAPQN=0:0 S QAPQN=$O(^QA(748.25,"E",SURVEY,QAPQN)) Q:QAPQN="" F DA=0:0 S DA=$O(^QA(748.25,"E",SURVEY,QAPQN,DA)) Q:DA="" S ^TMP($J,SURVEY,QAPQN,DA)=""
14 F QAPQN=0:0 S QAPQN=$O(^TMP($J,SURVEY,QAPQN)) Q:QAPQN="" F DA=0:0 S DA=$O(^TMP($J,SURVEY,QAPQN,DA)) Q:DA="" DO
15 .S NINCREM=INCREM+NINCREM
16 .S DR=".015////"_NINCREM,DA(1)=SURVEY,(DIC,DIE)="^QA(748.25,DA(1),1," D ^DIE W "."
17 ;
18EXIT I $D(EDIT) K EDIT Q
19 Q
20 ;
21R1 S EDIT=1 N DIC,DIE,DR,QAPQN,INCREM,DA
22 W @IOF,! S QAPHDR="Resequence Survey Question Numbers" X QAPBAR
23 S SVYNAME=$P(^QA(748,SURVEY,0),U,1)
24 S QLINE=$Y D EN1 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,LSTNUM=I
25 K SVYNAME Q ;kill variables in calling program
Note: See TracBrowser for help on using the repository browser.