- 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 Feb 19, 2025@00:04:51 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