- QAPRSEQ ;557/THM-RESEQUENCE SURVEY QUESTION ORDER [ 05/18/95 7:42 AM ]
- ;;2.0;Survey Generator;;Jun 20, 1995
- ;
- Q ;enter properly
- EN1 X CLEOP1 I $O(^QA(748.25,"E",SURVEY,0))="" W !!,*7,"There are no questions to resequence " H 2 G EXIT
- W !!,"What increment would you like to use? 1// " R INCREM:DTIME G:'$T!(INCREM[U) EXIT
- 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
- 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
- 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
- ;
- RGO K ^TMP($J) S NINCREM=0 W !!
- ;write to ^TMP($J to avoid editing problems when index changes
- 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)=""
- 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
- .S NINCREM=INCREM+NINCREM
- .S DR=".015////"_NINCREM,DA(1)=SURVEY,(DIC,DIE)="^QA(748.25,DA(1),1," D ^DIE W "."
- ;
- EXIT I $D(EDIT) K EDIT Q
- Q
- ;
- R1 S EDIT=1 N DIC,DIE,DR,QAPQN,INCREM,DA
- W @IOF,! S QAPHDR="Resequence Survey Question Numbers" X QAPBAR
- S SVYNAME=$P(^QA(748,SURVEY,0),U,1)
- 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
- K SVYNAME Q ;kill variables in calling program
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPRSEQ 1658 printed Feb 19, 2025@00:04:59 Page 2
- QAPRSEQ ;557/THM-RESEQUENCE SURVEY QUESTION ORDER [ 05/18/95 7:42 AM ]
- +1 ;;2.0;Survey Generator;;Jun 20, 1995
- +2 ;
- +3 ;enter properly
- QUIT
- EN1 XECUTE CLEOP1
- IF $ORDER(^QA(748.25,"E",SURVEY,0))=""
- WRITE !!,*7,"There are no questions to resequence "
- HANG 2
- GOTO EXIT
- +1 WRITE !!,"What increment would you like to use? 1// "
- READ INCREM:DTIME
- if '$TEST!(INCREM[U)
- GOTO EXIT
- +2 if INCREM=""
- SET INCREM=1
- IF INCREM<1!(INCREM>10)
- WRITE !!,*7,"Enter the value to skip between question numbers (1-10).",!!
- HANG 2
- GOTO EN1
- +3 ;force non-decimal numbers for resequencing
- IF INCREM'?1.2N
- WRITE !!,*7,"The increment must be 1-2 numbers, without decimals.",!!
- HANG 2
- GOTO EN1
- +4 WRITE @IOF,!
- XECUTE QAPBAR
- WRITE !!,"Selected parameters:",!!!,"Survey name: ",SVYNAME,!?2,"Increment: ",INCREM,!!
- KILL DIR
- SET DIR("A")="Is this Ok"
- SET DIR("B")="NO"
- SET DIR(0)="Y"
- DO ^DIR
- if Y'=1
- GOTO EN1
- +5 ;
- RGO KILL ^TMP($JOB)
- SET NINCREM=0
- WRITE !!
- +1 ;write to ^TMP($J to avoid editing problems when index changes
- +2 FOR QAPQN=0:0
- SET QAPQN=$ORDER(^QA(748.25,"E",SURVEY,QAPQN))
- if QAPQN=""
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^QA(748.25,"E",SURVEY,QAPQN,DA))
- if DA=""
- QUIT
- SET ^TMP($JOB,SURVEY,QAPQN,DA)=""
- +3 FOR QAPQN=0:0
- SET QAPQN=$ORDER(^TMP($JOB,SURVEY,QAPQN))
- if QAPQN=""
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^TMP($JOB,SURVEY,QAPQN,DA))
- if DA=""
- QUIT
- Begin DoDot:1
- +4 SET NINCREM=INCREM+NINCREM
- +5 SET DR=".015////"_NINCREM
- SET DA(1)=SURVEY
- SET (DIC,DIE)="^QA(748.25,DA(1),1,"
- DO ^DIE
- WRITE "."
- End DoDot:1
- +6 ;
- EXIT IF $DATA(EDIT)
- KILL EDIT
- QUIT
- +1 QUIT
- +2 ;
- R1 SET EDIT=1
- NEW DIC,DIE,DR,QAPQN,INCREM,DA
- +1 WRITE @IOF,!
- SET QAPHDR="Resequence Survey Question Numbers"
- XECUTE QAPBAR
- +2 SET SVYNAME=$PIECE(^QA(748,SURVEY,0),U,1)
- +3 SET QLINE=$Y
- DO EN1
- KILL DANS
- FOR I=0:0
- SET I=$ORDER(^QA(748.25,"E",SURVEY,I))
- if I=""
- QUIT
- FOR J=0:0
- SET J=$ORDER(^QA(748.25,"E",SURVEY,I,J))
- if J=""
- QUIT
- SET DANS(I,J)=I
- SET DANS(I)=I
- SET LSTNUM=I
- +4 ;kill variables in calling program
- KILL SVYNAME
- QUIT