QAPCHX1 ;557/THM-EDITING OF ANSWERS [ 07/12/95 7:11 AM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
;called from QAPEDI1
;
USINPT ;multiple choice
K ANS,QANS,STOP
S ANSTYPE=$P(^QA(748.25,SURVEY,1,QNAME,0),U,3),GRADIENT=$P(^(0),U,4)
S INSERT=$S(ANSTYPE="a":"letter",1:"number"),CNTA=0
I "^a^n^"[ANSTYPE F QANS=0:0 S QANS=$O(^QA(748.25,SURVEY,1,QNAME,3,QANS)) Q:QANS=""!(+QANS=0) S CNTA=CNTA+1,ANS($S(ANSTYPE="a":$C(CNTA+96),1:CNTA))=$P(^QA(748.25,SURVEY,1,QNAME,3,QANS,0),U)
;Likert scale
I ANSTYPE="l" D LIKRTLAB^QAPCHX K QANS
;
DIS I ANSTYPE'="l" W !! DO
.S (X,Y,CNTA)=0 F S X=$O(ANS(X)) Q:X="" S CNTA=CNTA+1 ;count answers
.S REM=CNTA#2,CNTA=(CNTA\2)+REM
.F XX=1:1:CNTA S X=XX S:ANSTYPE="a" X=$C(X+96) W X,". ",ANS(X) S:ANSTYPE="a" X=$C($A(X)+CNTA) S:ANSTYPE'="a" X=X+CNTA W:$D(ANS(X)) ?40,X,". ",ANS(X),!
I $D(REM),REM>0 W !
;
A1 S DA(1)=FILEDA,PRESPON=$P(^QA(748.3,DA(1),1,QUES,0),U,2)
S:PRESPON=" " PRESPON="Question skipped"
W !?5,"Previous response: ",PRESPON,! S QLINE=$S(ACTION="I":$Y+1,1:$Y) W !
A1A W ?5,"Enter the ",INSERT," of your response: "_$S(PRESPON["skipped":"",1:PRESPON_"// ")
R ANSW:DTIME S:'$T STOP=1 S:ANSW[U QAPOUT=1 Q:QAPOUT=1!($D(STOP))
I ANSTYPE="a" S ANSW=$TR(ANSW,"ABCDEFGHIJKLMNOPQRSTUVWXYZ ","abcdefghijklmnopqrstuvwxyz")
I ANSW="" Q
I '$D(ANS(ANSW)) W *7,!!,"You must enter a ",$S(ANSTYPE="a":"letter",1:"number")," from the selection given. " H 2 X CLEOP1 G A1A
;
A2 K DR S (DIC,DIE)="^QA(748.3,DA(1),1,",DA=QUES,DIC(0)="NM",DR="1////"_ANSW D ^DIE
K ANS,ANSW,INSERT,DIC,DIE,X
Q
;
QAYN ;yes/no/na
K STOP S DA(1)=FILEDA W !! S PRESPON=$P(^QA(748.3,DA(1),1,QUES,0),U,2)
S PRESPON=$S(PRESPON="Y":"Yes",PRESPON="N":"No",PRESPON="NA":"Not applicable",1:"Question skipped")
W ?5,"Previous response: ",PRESPON,! S QLINE=$S(ACTION="I":$Y+1,1:$Y) W !
;
QAYNA W ?5,"Enter Yes, No, or Not applicable (Y/N/NA): "_$S(PRESPON["skipped":"",1:PRESPON_"// ") R ANSW:DTIME S:'$T STOP=1 S:ANSW[U QAPOUT=1 Q:QAPOUT=1!($D(STOP))
S ANSW=$TR(ANSW,"any ","ANY"),ANSW=$E(ANSW,1,2)
I ANSW="" Q
I ANSW'="N",ANSW'="Y",ANSW'="NA" W *7 W !!,"Enter Y for Yes or N for No or NA for not applicable. " H 2 X CLEOP1 G QAYNA
;
B2 K DR S DA(1)=FILEDA,(DIC,DIE)="^QA(748.3,DA(1),1,",DA=QUES,DIC(0)="NM",DR="1////"_ANSW D ^DIE
K ANSW,DIC,DIE,X
Q
;
QATF ;true/false/na
K STOP S DA(1)=FILEDA W !! S PRESPON=$P(^QA(748.3,DA(1),1,QUES,0),U,2)
S PRESPON=$S(PRESPON="T":"True",PRESPON="NA":"Not applicable",PRESPON="F":"False",1:"Question skipped")
W ?5,"Previous response: ",PRESPON,! S QLINE=$S(ACTION="I":$Y+1,1:$Y) W !
;
QATFA W ?10,"True, False, or NA (T/F/NA): "_$S(PRESPON["skipped":"",1:PRESPON_"// ")
R ANSW:DTIME S:'$T STOP=1 S:ANSW[U QAPOUT=1 Q:QAPOUT=1!($D(STOP))
S ANSW=$TR(ANSW,"anft ","ANFT"),ANSW=$E(ANSW,1,2)
I ANSW="" S ANSW=" " Q
I ANSW'="T",ANSW'="F",ANSW'="NA" W *7,!!,"Enter T for True, F for False, or NA for not applicable." H 2 X CLEOP1 G QATFA
;
;file answer
C2 K DR S DA(1)=FILEDA,(DIC,DIE)="^QA(748.3,DA(1),1,",DA=QUES,DIC(0)="NM",DR="1////"_ANSW D ^DIE
K ANSW,DIC,DIE,X
Q
;
WP ;wp response
S QAPEDTR=$P($G(^VA(200,+DUZ,1)),U,5),QAPEDTR=$S(QAPEDTR=2:"SCREENMAN",1:"LINE EDITOR") ;see which wp editor they use
W !! S QLINE=$Y
WP1 W "This will be a word processing response.",!!,"Press RETURN to enter a response,",!?6,"^ to skip response entry or Q to QUIT RETURN// " R ANS:DTIME I '$T S QAPOUT=1 Q
I ANS["?" X CLEOP1 W " ^ will skip entering any response to this question",!," RETURN will allow you to enter a response",!," Q will allow you to abort or suspend",!!,"Press RETURN " R ANS:DTIME S:'$T QAPOUT=1 Q:'$T X CLEOP1 G WP1
I ANS[U Q
S ANS=$TR(ANS,"q","Q") I ANS="Q" S QAPOUT=1 Q
I QAPEDTR'["SCREENMAN" W @IOF,!
K DR S DA(1)=FILEDA,(DIC,DIE)="^QA(748.3,DA(1),1,",DA=QUES,DIC(0)="NM",DR=2 D ^DIE
K DIC,DIE,X,QAPEDTR
W @IOF,! X QAPBAR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPCHX1 3897 printed Dec 13, 2024@02:38:10 Page 2
QAPCHX1 ;557/THM-EDITING OF ANSWERS [ 07/12/95 7:11 AM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
+3 ;called from QAPEDI1
+4 ;
USINPT ;multiple choice
+1 KILL ANS,QANS,STOP
+2 SET ANSTYPE=$PIECE(^QA(748.25,SURVEY,1,QNAME,0),U,3)
SET GRADIENT=$PIECE(^(0),U,4)
+3 SET INSERT=$SELECT(ANSTYPE="a":"letter",1:"number")
SET CNTA=0
+4 IF "^a^n^"[ANSTYPE
FOR QANS=0:0
SET QANS=$ORDER(^QA(748.25,SURVEY,1,QNAME,3,QANS))
if QANS=""!(+QANS=0)
QUIT
SET CNTA=CNTA+1
SET ANS($SELECT(ANSTYPE="a":$CHAR(CNTA+96),1:CNTA))=$PIECE(^QA(748.25,SURVEY,1,QNAME,3,QANS,0),U)
+5 ;Likert scale
+6 IF ANSTYPE="l"
DO LIKRTLAB^QAPCHX
KILL QANS
+7 ;
DIS IF ANSTYPE'="l"
WRITE !!
Begin DoDot:1
+1 ;count answers
SET (X,Y,CNTA)=0
FOR
SET X=$ORDER(ANS(X))
if X=""
QUIT
SET CNTA=CNTA+1
+2 SET REM=CNTA#2
SET CNTA=(CNTA\2)+REM
+3 FOR XX=1:1:CNTA
SET X=XX
if ANSTYPE="a"
SET X=$CHAR(X+96)
WRITE X,". ",ANS(X)
if ANSTYPE="a"
SET X=$CHAR($ASCII(X)+CNTA)
if ANSTYPE'="a"
SET X=X+CNTA
if $DATA(ANS(X))
WRITE ?40,X,". ",ANS(X),!
End DoDot:1
+4 IF $DATA(REM)
IF REM>0
WRITE !
+5 ;
A1 SET DA(1)=FILEDA
SET PRESPON=$PIECE(^QA(748.3,DA(1),1,QUES,0),U,2)
+1 if PRESPON=" "
SET PRESPON="Question skipped"
+2 WRITE !?5,"Previous response: ",PRESPON,!
SET QLINE=$SELECT(ACTION="I":$Y+1,1:$Y)
WRITE !
A1A WRITE ?5,"Enter the ",INSERT," of your response: "_$SELECT(PRESPON["skipped":"",1:PRESPON_"// ")
+1 READ ANSW:DTIME
if '$TEST
SET STOP=1
if ANSW[U
SET QAPOUT=1
if QAPOUT=1!($DATA(STOP))
QUIT
+2 IF ANSTYPE="a"
SET ANSW=$TRANSLATE(ANSW,"ABCDEFGHIJKLMNOPQRSTUVWXYZ ","abcdefghijklmnopqrstuvwxyz")
+3 IF ANSW=""
QUIT
+4 IF '$DATA(ANS(ANSW))
WRITE *7,!!,"You must enter a ",$SELECT(ANSTYPE="a":"letter",1:"number")," from the selection given. "
HANG 2
XECUTE CLEOP1
GOTO A1A
+5 ;
A2 KILL DR
SET (DIC,DIE)="^QA(748.3,DA(1),1,"
SET DA=QUES
SET DIC(0)="NM"
SET DR="1////"_ANSW
DO ^DIE
+1 KILL ANS,ANSW,INSERT,DIC,DIE,X
+2 QUIT
+3 ;
QAYN ;yes/no/na
+1 KILL STOP
SET DA(1)=FILEDA
WRITE !!
SET PRESPON=$PIECE(^QA(748.3,DA(1),1,QUES,0),U,2)
+2 SET PRESPON=$SELECT(PRESPON="Y":"Yes",PRESPON="N":"No",PRESPON="NA":"Not applicable",1:"Question skipped")
+3 WRITE ?5,"Previous response: ",PRESPON,!
SET QLINE=$SELECT(ACTION="I":$Y+1,1:$Y)
WRITE !
+4 ;
QAYNA WRITE ?5,"Enter Yes, No, or Not applicable (Y/N/NA): "_$SELECT(PRESPON["skipped":"",1:PRESPON_"// ")
READ ANSW:DTIME
if '$TEST
SET STOP=1
if ANSW[U
SET QAPOUT=1
if QAPOUT=1!($DATA(STOP))
QUIT
+1 SET ANSW=$TRANSLATE(ANSW,"any ","ANY")
SET ANSW=$EXTRACT(ANSW,1,2)
+2 IF ANSW=""
QUIT
+3 IF ANSW'="N"
IF ANSW'="Y"
IF ANSW'="NA"
WRITE *7
WRITE !!,"Enter Y for Yes or N for No or NA for not applicable. "
HANG 2
XECUTE CLEOP1
GOTO QAYNA
+4 ;
B2 KILL DR
SET DA(1)=FILEDA
SET (DIC,DIE)="^QA(748.3,DA(1),1,"
SET DA=QUES
SET DIC(0)="NM"
SET DR="1////"_ANSW
DO ^DIE
+1 KILL ANSW,DIC,DIE,X
+2 QUIT
+3 ;
QATF ;true/false/na
+1 KILL STOP
SET DA(1)=FILEDA
WRITE !!
SET PRESPON=$PIECE(^QA(748.3,DA(1),1,QUES,0),U,2)
+2 SET PRESPON=$SELECT(PRESPON="T":"True",PRESPON="NA":"Not applicable",PRESPON="F":"False",1:"Question skipped")
+3 WRITE ?5,"Previous response: ",PRESPON,!
SET QLINE=$SELECT(ACTION="I":$Y+1,1:$Y)
WRITE !
+4 ;
QATFA WRITE ?10,"True, False, or NA (T/F/NA): "_$SELECT(PRESPON["skipped":"",1:PRESPON_"// ")
+1 READ ANSW:DTIME
if '$TEST
SET STOP=1
if ANSW[U
SET QAPOUT=1
if QAPOUT=1!($DATA(STOP))
QUIT
+2 SET ANSW=$TRANSLATE(ANSW,"anft ","ANFT")
SET ANSW=$EXTRACT(ANSW,1,2)
+3 IF ANSW=""
SET ANSW=" "
QUIT
+4 IF ANSW'="T"
IF ANSW'="F"
IF ANSW'="NA"
WRITE *7,!!,"Enter T for True, F for False, or NA for not applicable."
HANG 2
XECUTE CLEOP1
GOTO QATFA
+5 ;
+6 ;file answer
C2 KILL DR
SET DA(1)=FILEDA
SET (DIC,DIE)="^QA(748.3,DA(1),1,"
SET DA=QUES
SET DIC(0)="NM"
SET DR="1////"_ANSW
DO ^DIE
+1 KILL ANSW,DIC,DIE,X
+2 QUIT
+3 ;
WP ;wp response
+1 ;see which wp editor they use
SET QAPEDTR=$PIECE($GET(^VA(200,+DUZ,1)),U,5)
SET QAPEDTR=$SELECT(QAPEDTR=2:"SCREENMAN",1:"LINE EDITOR")
+2 WRITE !!
SET QLINE=$Y
WP1 WRITE "This will be a word processing response.",!!,"Press RETURN to enter a response,",!?6,"^ to skip response entry or Q to QUIT RETURN// "
READ ANS:DTIME
IF '$TEST
SET QAPOUT=1
QUIT
+1 IF ANS["?"
XECUTE CLEOP1
WRITE " ^ will skip entering any response to this question",!," RETURN will allow you to enter a response",!," Q will allow you to abort or suspend",!!,"Press RETURN "
READ ANS:DTIME
if '$TEST
SET QAPOUT=1
if '$TEST
QUIT
XECUTE CLEOP1
GOTO WP1
+2 IF ANS[U
QUIT
+3 SET ANS=$TRANSLATE(ANS,"q","Q")
IF ANS="Q"
SET QAPOUT=1
QUIT
+4 IF QAPEDTR'["SCREENMAN"
WRITE @IOF,!
+5 KILL DR
SET DA(1)=FILEDA
SET (DIC,DIE)="^QA(748.3,DA(1),1,"
SET DA=QUES
SET DIC(0)="NM"
SET DR=2
DO ^DIE
+6 KILL DIC,DIE,X,QAPEDTR
+7 WRITE @IOF,!
XECUTE QAPBAR
+8 QUIT
