source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPCHKST.m@ 1604

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1QAPCHKST ;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
22REL 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
Note: See TracBrowser for help on using the repository browser.