source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPPTUSR.m@ 1639

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1QAPPTUSR ;557/THM-PRINT HARD COPY FOR USERS [ 06/13/96 3:34 PM ]
2 ;;2.0;Survey Generator;**5**;Jun 20, 1995
3 ;
4 D SCREEN^QAPUTIL
5EN K USERPRT W @IOF,! S QAPHDR="Print a Survey Hardcopy" X QAPBAR S QAPHDR="Survey Selection" X QAPBAR
6 W !!,"This program allows you to print a hardcopy of a survey for your",!,"review ",BLDON,"before",BLDOFF," you actually participate in it.",!!,"It will not print answers you have previously made to this or",!,"other surveys.",!!
7 K DIC S DIC="^QA(748,",DIC(0)="AEQMZ",DIC("A")="Select a survey: " D ^DIC K DIC G:X=""!(X[U) EXIT^QAPPT1
8 S SURVEY=+Y,STATUS=$P(^QA(748,SURVEY,0),U,4),TITLE=$P(^(0),U,6),ACTION="F"
9 I STATUS'="r" W !!,*7,"This survey cannot be printed now. Its status is ",BLDON,$S(STATUS="d":"Under development",1:"Active life expired"),BLDOFF,".",!!,"Press RETURN " R ANS:DTIME G:'$T EXIT^QAPPT1 G EN
10 W @IOF,! S QAPHDR="Printing Survey Title: "_TITLE X QAPBAR
11 S %ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS G:POP EXIT^QAPPT1
12 I $D(IO("Q")) S ZTREQ="@",ZTIO=ION,ZTRTN="PRINT^QAPPT1",ZTDESC="Print "_TITLE_" Survey" F X="SURVEY","TITLE","ACTION" S ZTSAVE(X)=""
13 I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task #",ZTSK,!! H 2 K ZTSK G EXIT^QAPPT1
14 G ^QAPPT1
Note: See TracBrowser for help on using the repository browser.