QAPADD ;557/THM-CREATE A NEW SURVEY, PART 1 [ 05/18/95 7:03 AM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
;called by QAPEDIT
Q ;enter properly
DV I $D(DUZ(2))#2=0 W !!,*7,"You do not have a division defined.",!! H 2 Q
I +DUZ(2)=0 W !!,*7,"Your division is incorrect.",!! H 2 Q
;
EN W @IOF,! S QAPHDR="Create a New Survey",QAPOUT=0 X QAPBAR
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
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
;
K EDIT
EN1 K DIR,OUT,STOP,DIC,DIE,DR
S SUBJ=$P(^QA(748,SURVEY,0),U) X CLEOP
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"
S DIE=DIC D ^DIE D:'$D(Y) S:'$D(Y) EDIT=1 I $D(DTOUT) S STOP=1 Q
.W !! I $O(^QA(748,DA,2,0))="" W !,*7,"Note: The survey description was not entered !",! H 2
.I $O(^QA(748,DA,4,0))="" W *7,"Note: The survey instructions were not entered !",! H 2
;
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
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.",!
I $D(%) G:%'=1 EN1 S DA=SURVEY,DIK="^QA(748," D ^DIK W !!,">> Survey deleted <<",! H 2 G EN
;
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
I $D(%Y),%Y["?" W !!,"Enter Y to edit this information or N to proceed.",! H 2 G REDIT
I $D(%),%=-1 DO G:'$D(STOP) REDIT G:$D(STOP) EXIT^QAPUTIL
.S QLINE=3 X CLEOP1
.W !,*7,"You have entered ""^"" to interrupt entry of this survey.",!
.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",!
.W "this point in this option. You will have to use the menu option",!,BLDON,"Delete a Survey, Questions and Responses",BLDOFF,".",!
.;
STOP .W !,"Is this what you really want to do" S %=2 D YN^DICN I %=1!($D(DTOUT)) S STOP=1
.I $D(%Y),%Y["?" W !!,"Enter Y to stop or N to begin the editing again.",! H 2 G STOP
D EN^QAPDEM ;do not allow ^ abort-incomplete record would be generated.
S (X,DINUM)=SURVEY,DIC(0)="QM",(DIC,DIE)="^QA(748.25," K DO,DD D FILE^DICN K DINUM
G ^QAPADD1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPADD 2537 printed Dec 13, 2024@02:38:06 Page 2
QAPADD ;557/THM-CREATE A NEW SURVEY, PART 1 [ 05/18/95 7:03 AM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
+3 ;called by QAPEDIT
+4 ;enter properly
QUIT
DV IF $DATA(DUZ(2))#2=0
WRITE !!,*7,"You do not have a division defined.",!!
HANG 2
QUIT
+1 IF +DUZ(2)=0
WRITE !!,*7,"Your division is incorrect.",!!
HANG 2
QUIT
+2 ;
EN WRITE @IOF,!
SET QAPHDR="Create a New Survey"
SET QAPOUT=0
XECUTE QAPBAR
+1 SET DIC("DR")=".055////"_DUZ
SET DIC="^QA(748,"
SET DIC(0)="AEQMLZ"
SET DIC("A")="Survey NAME: "
XECUTE CLEOP
DO ^DIC
if $DATA(DTOUT)
SET STOP=1
if X=""!(X[U)
SET QAPOUT=1
IF $DATA(DTOUT)!(QAPOUT=1)
KILL X,Y
QUIT
+2 SET SURVEY=+Y
IF $PIECE(Y,U,3)'=1
WRITE *7,!!,"This is not a new survey.",!,"Please use the edit feature for any changes.",!
HANG 2
GOTO EN
+3 ;
+4 KILL EDIT
EN1 KILL DIR,OUT,STOP,DIC,DIE,DR
+1 SET SUBJ=$PIECE(^QA(748,SURVEY,0),U)
XECUTE CLEOP
+2 SET DA=SURVEY
SET DIC="^QA(748,"
SET DR=".02////"_$PIECE(^DIC(4,DUZ(2),99),U,1)_";.01;.015;.03;.04;4;.05////d;.08;.1;5;1;2"
+3 SET DIE=DIC
DO ^DIE
if '$DATA(Y)
Begin DoDot:1
+4 WRITE !!
IF $ORDER(^QA(748,DA,2,0))=""
WRITE !,*7,"Note: The survey description was not entered !",!
HANG 2
+5 IF $ORDER(^QA(748,DA,4,0))=""
WRITE *7,"Note: The survey instructions were not entered !",!
HANG 2
End DoDot:1
if '$DATA(Y)
SET EDIT=1
IF $DATA(DTOUT)
SET STOP=1
QUIT
+6 ;
DEL KILL %,%Y
IF $DATA(Y)
IF '$DATA(EDIT)
WRITE *7,!!,"Do you really want to delete this survey"
SET %=2
DO YN^DICN
IF $DATA(DTOUT)
SET STOP=1
QUIT
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"If you answer Y you will have to re-enter the survey information.",!,"If you answer N you will return to editing.",!
+2 IF $DATA(%)
if %'=1
GOTO EN1
SET DA=SURVEY
SET DIK="^QA(748,"
DO ^DIK
WRITE !!,">> Survey deleted <<",!
HANG 2
GOTO EN
+3 ;
REDIT KILL STOP,DTOUT,DUOUT
WRITE @IOF,!
XECUTE QAPBAR
WRITE !!,"Do you wish to edit any of this basic information"
SET %=2
DO YN^DICN
if $DATA(DTOUT)
SET STOP=1
if $DATA(STOP)
QUIT
IF %=1
WRITE @IOF,!
XECUTE QAPBAR
GOTO EN1
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to edit this information or N to proceed.",!
HANG 2
GOTO REDIT
+2 IF $DATA(%)
IF %=-1
Begin DoDot:1
+3 SET QLINE=3
XECUTE CLEOP1
+4 WRITE !,*7,"You have entered ""^"" to interrupt entry of this survey.",!
+5 WRITE !!,"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",!
+6 WRITE "this point in this option. You will have to use the menu option",!,BLDON,"Delete a Survey, Questions and Responses",BLDOFF,".",!
+7 ;
STOP WRITE !,"Is this what you really want to do"
SET %=2
DO YN^DICN
IF %=1!($DATA(DTOUT))
SET STOP=1
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to stop or N to begin the editing again.",!
HANG 2
GOTO STOP
End DoDot:1
if '$DATA(STOP)
GOTO REDIT
if $DATA(STOP)
GOTO EXIT^QAPUTIL
+2 ;do not allow ^ abort-incomplete record would be generated.
DO EN^QAPDEM
+3 SET (X,DINUM)=SURVEY
SET DIC(0)="QM"
SET (DIC,DIE)="^QA(748.25,"
KILL DO,DD
DO FILE^DICN
KILL DINUM
+4 GOTO ^QAPADD1
