QAPPART ;557/THM-COUNT NUMBER OF SURVEY PARTICIPANTS [ 02/16/95 8:26 AM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
D SCREEN^QAPUTIL
EN W @IOF,! S QAPHDR="Count Survey Participants" X QAPBAR
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 survey: " W ! D ^DIC G:X=""!(X[U) EXIT S SURVEY=+Y,SUBJ=Y(0,0) K DIC("S")
S (ICNT,SCNT,CCNT)=0
F X=0:0 S X=$O(^QA(748.3,"B",SURVEY,X)) Q:X="" DO
.I $P(^QA(748.3,X,0),U,3)="c" S CCNT=CCNT+1
.I $P(^QA(748.3,X,0),U,3)="s" S SCNT=SCNT+1
.I $P(^QA(748.3,X,0),U,3)="i" S ICNT=ICNT+1
S QLINE=3 X CLEOP1 W !!,"Survey: ",SUBJ,!
I CCNT=0 S CCNT="no"
I SCNT=0 S SCNT="no"
I ICNT=0 S ICNT="no"
W !!,"Currently, there ",$S(CCNT=1:"is",1:"are")," ",CCNT," completed ",$S(CCNT=1:"response",1:"responses"),".",!
W ?17,$S(SCNT=1:"is ",1:"are "),SCNT," suspended ",$S(SCNT=1:"response",1:"responses"),".",!
W ?17,$S(ICNT=1:"is ",1:"are "),ICNT," ",$S(ICNT=1:"response",1:"responses")," in progress.",!
W !!,"Press RETURN to continue " R ANS:DTIME I $T G EN
;
EXIT G EXIT^QAPUTIL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPPART 1144 printed Nov 22, 2024@17:48:20 Page 2
QAPPART ;557/THM-COUNT NUMBER OF SURVEY PARTICIPANTS [ 02/16/95 8:26 AM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
+3 DO SCREEN^QAPUTIL
EN WRITE @IOF,!
SET QAPHDR="Count Survey Participants"
XECUTE QAPBAR
+1 KILL DIC
SET DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"
+2 SET DIC="^QA(748,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select survey: "
WRITE !
DO ^DIC
if X=""!(X[U)
GOTO EXIT
SET SURVEY=+Y
SET SUBJ=Y(0,0)
KILL DIC("S")
+3 SET (ICNT,SCNT,CCNT)=0
+4 FOR X=0:0
SET X=$ORDER(^QA(748.3,"B",SURVEY,X))
if X=""
QUIT
Begin DoDot:1
+5 IF $PIECE(^QA(748.3,X,0),U,3)="c"
SET CCNT=CCNT+1
+6 IF $PIECE(^QA(748.3,X,0),U,3)="s"
SET SCNT=SCNT+1
+7 IF $PIECE(^QA(748.3,X,0),U,3)="i"
SET ICNT=ICNT+1
End DoDot:1
+8 SET QLINE=3
XECUTE CLEOP1
WRITE !!,"Survey: ",SUBJ,!
+9 IF CCNT=0
SET CCNT="no"
+10 IF SCNT=0
SET SCNT="no"
+11 IF ICNT=0
SET ICNT="no"
+12 WRITE !!,"Currently, there ",$SELECT(CCNT=1:"is",1:"are")," ",CCNT," completed ",$SELECT(CCNT=1:"response",1:"responses"),".",!
+13 WRITE ?17,$SELECT(SCNT=1:"is ",1:"are "),SCNT," suspended ",$SELECT(SCNT=1:"response",1:"responses"),".",!
+14 WRITE ?17,$SELECT(ICNT=1:"is ",1:"are "),ICNT," ",$SELECT(ICNT=1:"response",1:"responses")," in progress.",!
+15 WRITE !!,"Press RETURN to continue "
READ ANS:DTIME
IF $TEST
GOTO EN
+16 ;
EXIT GOTO EXIT^QAPUTIL
