QAPPRALL ;557/THM-PRINT ALL RESPONSES [ 06/19/95 12:49 PM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
D SCREEN^QAPUTIL
EN K USERPRT W @IOF,! S QAPHDR="Print All Survey Responses" X QAPBAR S QAPHDR="Survey Selection" X QAPBAR
W !!,"This program will print all responses to the selected survey",!,"individually. ",BLDON,"You must use your own judgement when printing",!,"long surveys because of the possible length of the printout.",BLDOFF,!!!
K DIC S DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"
S DIC="^QA(748,",DIC(0)="AEQMZ",DIC("A")="Select a survey: " D ^DIC K DIC G:X=""!(X[U) EXIT^QAPUTIL
K DIC S SURVEY=+Y,TITLE=$P(^QA(748,SURVEY,0),U,6)
S TOTPART=0 F PART=0:0 S PART=$O(^QA(748.3,"B",SURVEY,PART)) Q:PART="" I $P(^QA(748.3,PART,0),U,3)="c" S TOTPART=TOTPART+1
W !!,*7,"There ",$S(TOTPART=1:"is ",1:"are "),TOTPART,$S(TOTPART=1:" response",1:" responses")," to this survey.",!
W ! S %ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS G:POP EXIT^QAPUTIL
I $D(IO("Q")) S ZTREQ="@",ZTIO=ION,ZTRTN="PRINT^QAPPRALL",ZTDESC="Print All Respones for "_TITLE_" Survey" F X="SURVEY","TITLE" S ZTSAVE(X)=""
I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task #",ZTSK,!! H 2 K ZTSK G EXIT^QAPUTIL
;
PRINT S QAPOUT=0,QAPDUZ="",USERPRT=1 F S QAPDUZ=$O(^QA(748.3,"AC",QAPDUZ)) Q:QAPDUZ=""!(QAPOUT=1) F FILEDA=0:0 S FILEDA=$O(^QA(748.3,"AC",QAPDUZ,SURVEY,FILEDA)) Q:FILEDA=""!(QAPOUT=1) W:IOST?1"P-".E @IOF,! D USERPRT^QAPPT1
G EXIT^QAPUTIL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPPRALL 1513 printed Dec 13, 2024@02:38:26 Page 2
QAPPRALL ;557/THM-PRINT ALL RESPONSES [ 06/19/95 12:49 PM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
+3 DO SCREEN^QAPUTIL
EN KILL USERPRT
WRITE @IOF,!
SET QAPHDR="Print All Survey Responses"
XECUTE QAPBAR
SET QAPHDR="Survey Selection"
XECUTE QAPBAR
+1 WRITE !!,"This program will print all responses to the selected survey",!,"individually. ",BLDON,"You must use your own judgement when printing",!,"long surveys because of the possible length of the printout.",BLDOFF,!!!
+2 KILL DIC
SET DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"
+3 SET DIC="^QA(748,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select a survey: "
DO ^DIC
KILL DIC
if X=""!(X[U)
GOTO EXIT^QAPUTIL
+4 KILL DIC
SET SURVEY=+Y
SET TITLE=$PIECE(^QA(748,SURVEY,0),U,6)
+5 SET TOTPART=0
FOR PART=0:0
SET PART=$ORDER(^QA(748.3,"B",SURVEY,PART))
if PART=""
QUIT
IF $PIECE(^QA(748.3,PART,0),U,3)="c"
SET TOTPART=TOTPART+1
+6 WRITE !!,*7,"There ",$SELECT(TOTPART=1:"is ",1:"are "),TOTPART,$SELECT(TOTPART=1:" response",1:" responses")," to this survey.",!
+7 WRITE !
SET %ZIS="AEQ"
SET %ZIS("A")="Output device: "
DO ^%ZIS
if POP
GOTO EXIT^QAPUTIL
+8 IF $DATA(IO("Q"))
SET ZTREQ="@"
SET ZTIO=ION
SET ZTRTN="PRINT^QAPPRALL"
SET ZTDESC="Print All Respones for "_TITLE_" Survey"
FOR X="SURVEY","TITLE"
SET ZTSAVE(X)=""
+9 IF $DATA(IO("Q"))
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Queued as task #",ZTSK,!!
HANG 2
KILL ZTSK
GOTO EXIT^QAPUTIL
+10 ;
PRINT SET QAPOUT=0
SET QAPDUZ=""
SET USERPRT=1
FOR
SET QAPDUZ=$ORDER(^QA(748.3,"AC",QAPDUZ))
if QAPDUZ=""!(QAPOUT=1)
QUIT
FOR FILEDA=0:0
SET FILEDA=$ORDER(^QA(748.3,"AC",QAPDUZ,SURVEY,FILEDA))
if FILEDA=""!(QAPOUT=1)
QUIT
if IOST?1"P-".E
WRITE @IOF,!
DO USERPRT^QAPPT1
+1 GOTO EXIT^QAPUTIL
