1 | QAPCHKST ;557/THM-CHECK IF SURVEY CAN BE RELEASED [ 05/04/95 9:53 AM ]
|
---|
2 | ;;2.0;Survey Generator;;Jun 20, 1995
|
---|
3 | ;called by input transform of STATUS in file 748 and QAPCOPY
|
---|
4 | ;
|
---|
5 | Q:$P(^QA(748,DA,0),U,4)="r"&('$D(QAPCOPY))
|
---|
6 | S QLINE=7 X CLEOP1 W !,"Please wait while this survey is checked for missing critical data " H 1
|
---|
7 | K NOPEN,CANCEL W !
|
---|
8 | I $P(^QA(748,DA,0),U,3)="" W *7,!,"Last date for usage is missing" S NOPEN=1
|
---|
9 | I $O(^QA(748,DA,1,0))="" W !,"Demographic data is missing" S NOPEN=1
|
---|
10 | I $O(^QA(748,DA,1,0))="",$P(^QA(748,DA,0),U,8)="y" W " and demographics are mandatory" S CANCEL=1
|
---|
11 | I $O(^QA(748,DA,1,0))="",$P(^QA(748,DA,0),U,8)'="y" W " (but demographics are not mandatory)" S NOPEN=1
|
---|
12 | I $P(^QA(748,DA,0),U,6)="" W !,"Survey title is missing" S CANCEL=1
|
---|
13 | I $O(^QA(748,DA,4,0))="" W !,"Survey instructions are missing" S CANCEL=1
|
---|
14 | I '$D(^QA(748.25,DA,0))!($O(^QA(748.25,DA,1,0))="") W !,"There are no questions for this survey" S CANCEL=1
|
---|
15 | I $O(^QA(748.25,DA,0))]"" F QNUM=0:0 S QNUM=$O(^QA(748.25,DA,1,QNUM)) Q:QNUM=""!(+QNUM=0) DO
|
---|
16 | .S QAPXX=^QA(748.25,DA,1,QNUM,0),QAPQN=$P(QAPXX,U,2)
|
---|
17 | .I $P(QAPXX,U,3)="","^w^y^t^"'[$G(^QA(748.25,DA,1,QNUM,1)) W !,"The answer type on question ",QAPQN," is not (a)lpha ,(n)umeric or (L)ikert" S CANCEL=1
|
---|
18 | .I $P(QAPXX,U,2)="" W !,"There is no question number for IFN ",QNUM S CANCEL=1
|
---|
19 | .I $D(^QA(748.25,DA,1,QNUM,1)),$P(^(1),U,1)="m",$P(QAPXX,U,3)'="l",$O(^QA(748.25,DA,1,QNUM,3,1))="" W !,"Question ",QAPQN," is multiple choice and has no answers" S CANCEL=1
|
---|
20 | .I $O(^QA(748.25,DA,1,QNUM,2,0))="" W !,"Question ",QAPQN," has no question text" S CANCEL=1
|
---|
21 | Q:$D(QAPCOPY) ;quit if copying a survey
|
---|
22 | REL I $D(NOPEN),'$D(CANCEL) W *7,!!,"Perhaps this survey should not be released",!,"until this data is supplied.",!
|
---|
23 | ;
|
---|
24 | I $D(NOPEN),'$D(CANCEL) W !,"Do you want to release anyway" S %=2 D YN^DICN I %<0!(%=2) K X S STOP=1 Q
|
---|
25 | I $D(%Y),%Y="?" X CLEOP1 W !,"Answer Y release the survey or N to leave it as is. " H 3 X CLEOP1 G REL
|
---|
26 | I $D(%Y),%Y["??" X CLEOP1 W !,"If you answer Y, the survey will be released regardless of",!,"what non-critical information is missing. N will leave it as is.",!!,"Press RETURN " R ANS:DTIME S:'$T DTOUT=1 I '$D(DTOUT) X CLEOP1 G REL
|
---|
27 | I $D(DTOUT) S STOP=1 Q
|
---|
28 | I $D(CANCEL) W !!,*7,"This survey is missing important data and cannot be released",!,"until it is supplied.",!! K X H 3
|
---|
29 | I $D(%),%=0 W !!,*7,"You must specifically answer Y or N. " H 2 X CLEOP1 G REL
|
---|
30 | I '$D(CANCEL) W !!,"Survey released. ",! H 2
|
---|
31 | K %,YY,NOPEN,ANS,CANCEL,QAPXX
|
---|
32 | Q
|
---|