source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPDEMS.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1QAPDEMS ;557/THM-DEMOGRAPHICAL STATISTICS, PART 1 [ 06/19/95 12:49 PM ]
2 ;;2.0;Survey Generator;;Jun 20, 1995
3 ;
4 D SCREEN^QAPUTIL
5EN W @IOF,! S QAPHDR="Survey Demographical Statistics" X QAPBAR S QAPHDR="Survey Selection" X QAPBAR
6 K DIC S DIC("S")="I $P(^(0),U,10)'=""c""!($P(^(0),U,5)=DUZ)!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"
7 S DIC="^QA(748,",DIC(0)="AEQMZ",DIC("A")="Select a survey: " D ^DIC K DIC G:X=""!(X[U) EXIT
8 S SURVEY=+Y,TITLE=$P(^QA(748,SURVEY,0),U,6)
9 W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Printing Demographical Information" X QAPBAR
10 S DEMO="",DEMO=$O(^QA(748,SURVEY,1,"B",DEMO)) I DEMO="" W !!,*7,"There were no demographics specified for this survey.",!!,"Press RETURN " R ANS:DTIME G:$D(DTOUT) EXIT G EN
11 K DIR S DIR("A")="Choose a sorting demographic",DIR(0)="SB^",CNT=0
12 S DEMO="" W !! F S DEMO=$O(^QA(748,SURVEY,1,"B",DEMO)) Q:DEMO="" F DA=0:0 S DA=$O(^QA(748,SURVEY,1,"B",DEMO,DA)) Q:DA="" S CNT=CNT+1,DIR(0)=DIR(0)_CNT_":"_$P(^QA(748,SURVEY,1,DA,0),U,1)_";" W !?10,CNT,". ",DEMO
13 W !! D ^DIR G:$D(DIRUT) EXIT S SORTTXT=Y(0),SORT=$O(^QA(748,SURVEY,1,"B",$E(SORTTXT,1,30),0)) ;pull pointer to match later
14 S DEMTYPE=$P(^QA(748,SURVEY,1,SORT,0),U,2)
15 W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Printing Demographical Information" X QAPBAR
16 ;
17BYPASS X CLEOP W "Do you want to include bypassed questions in the",!,"statistics calculations" S %=2 D YN^DICN G:%<0 EXIT S BYPASS=%
18 I $D(%Y),%Y["?" W !!,"Enter Y to print questions skipped by the participants",!,"or No to not print them." H 3 G BYPASS
19 ;
20BYPASSNA K %Y X CLEOP W !!,"Do you want to include 'Not Applicable' responses in the",!,"statistics calculations" S %=2 D YN^DICN G:%<0 EXIT S BYPASSNA=%
21 I $D(%Y),%Y["?" W !!,"Enter Y to print responses of 'Not Applicable'",!,"or No to not print them." H 3 G BYPASSNA
22 ;
23WPPRT K %Y X CLEOP W "Do you want to print word processing responses" S %=2 D YN^DICN G:%<0 EXIT S WPPRT=%
24 I $D(%Y),%Y["?" W !!,"Enter Y to print word processing questions or No to not print them." H 3 G WPPRT
25 S %ZIS="AEQ",%ZIS("A")="Output device: " W !! D ^%ZIS G:POP EXIT
26 I $D(IO("Q")) S ZTREQ="@",ZTIO=ION,ZTRTN="PRINT^QAPDEMS1",ZTDESC="Print "_TITLE_" Survey Demographical Statistics" F X="WPPRT","BYPASS*","DEMTYPE","SURVEY","TITLE","SORT*" S ZTSAVE(X)=""
27 I D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task #",ZTSK,!! H 3 G EXIT
28 G ^QAPDEMS1
29 ;
30EXIT G EXIT^QAPUTIL
Note: See TracBrowser for help on using the repository browser.