| [613] | 1 | QAPUTIL2 ;557/THM-SURVEY GENERATOR UTILITIES, PART 3 [ 07/24/96  2:46 PM ]
 | 
|---|
 | 2 |  ;;2.0;Survey Generator;**2,5**;Jun 20, 1995
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 | HELP2 ;from QAPEDIT
 | 
|---|
 | 5 |  K DTOUT,DIRUT X:$D(CLEOP) CLEOP W !!!,"Select  C to create a completely new survey",!
 | 
|---|
 | 6 |  W "        B to change only the basic survey information",!
 | 
|---|
 | 7 |  W "        D to add or edit demographic survey fields",!
 | 
|---|
 | 8 |  W "        E to edit all survey questions in current order",!
 | 
|---|
 | 9 |  W "        I to add or edit individual survey questions",!
 | 
|---|
 | 10 |  W "        P to print a copy of the survey",!
 | 
|---|
 | 11 |  W "        Q, '^' or <RETURN> to EXIT",!
 | 
|---|
 | 12 |  W !!,"Press RETURN  " R ANS:30 I '$T X:$D(CLEOP) CLEOP S DIRUT=1 Q
 | 
|---|
 | 13 |  X:$D(CLEOP) CLEOP Q
 | 
|---|
 | 14 |  ;
 | 
|---|
 | 15 | HELP3 ;demographic help (from input transform)
 | 
|---|
 | 16 |  N QLINE
 | 
|---|
 | 17 |  S QLINE=20 X:$D(CLEOP1) CLEOP1 W !,"Do you want to see extended help" S %=2 D YN^DICN S QLINE=4 X:$D(CLEOP1) CLEOP1 G:%'=1 HELP3Q I $D(DUOUT)!($D(DTOUT)) S QAPOUT=1 Q
 | 
|---|
 | 18 |  W !,"Demographic data  items are  optional.  You may  wish to  include them in",!
 | 
|---|
 | 19 |  W "order to identify the survey participant or group, or to sort on specific",!
 | 
|---|
 | 20 |  W "demographic items.  Note that  while including demographic  data items in",!
 | 
|---|
 | 21 |  W "your survey is up  to you, you may also make them  mandatory entry fields",!
 | 
|---|
 | 22 |  W "for your survey participants.",!!
 | 
|---|
 | 23 |  W "First you  must enter the text for your  demographic data item  as it should",!
 | 
|---|
 | 24 |  W "be displayed on the survey.  Then you will be asked what TYPE of demographic",!
 | 
|---|
 | 25 |  W "it is.  They  may be pointers  to existing  DHCP files, sets of  codes, free",!
 | 
|---|
 | 26 |  W "text, or dates.",!!,"Press RETURN  " R ANS:DTIME I '$T S DTOUT=1 Q
 | 
|---|
 | 27 | HELP3Q S QLINE=3 X:$D(CLEOP1) CLEOP1
 | 
|---|
 | 28 |  Q
 | 
|---|
 | 29 |  ;
 | 
|---|
 | 30 | HELP4 ;password help
 | 
|---|
 | 31 |  W !!,"You may password-protect your survey  from unauthorized participants.",!
 | 
|---|
 | 32 |  W "Using the password is optional and if you decide to use one and enter",!
 | 
|---|
 | 33 |  W "it here, you will have to communicate it to all participants.",!
 | 
|---|
 | 34 |  Q
 | 
|---|
 | 35 |  ;
 | 
|---|
 | 36 | DEMLST ;print demographics on hard copies - from QAPPT0
 | 
|---|
 | 37 |  S QAPOUT=0 Q:$O(^QA(748,SURVEY,1,0))=""  ;none to print
 | 
|---|
 | 38 |  S QAPCOL=0 F DEMDA=0:0 S DEMDA=$O(^QA(748,SURVEY,1,DEMDA)) Q:DEMDA=""!(+DEMDA=0)!(QAPOUT=1)  DO  I QAPOUT=1 S DEMDA="9999"
 | 
|---|
 | 39 |  .S DEMVAL=$P(^QA(748,SURVEY,1,DEMDA,0),U),DEMTYPE=$P(^QA(748,SURVEY,1,DEMDA,0),U,2)
 | 
|---|
 | 40 |  .W ?(QAPCOL),DEMVAL_":  " D:'$D(USERPRT)&(DEMTYPE="s") DEMSHOW Q:QAPOUT=1  D:$D(USERPRT)  S QAPCOL=QAPCOL+40 I QAPCOL>50 S QAPCOL=0  W !! X:$D(TOF) TOF Q:QAPOUT=1
 | 
|---|
 | 41 |  ..S DEML=$O(^QA(748.3,FILEDA,2,"B",DEMDA,0)) Q:DEML=""  ;no type/demog 
 | 
|---|
 | 42 |  ..S DEMVAL=$P(^QA(748.3,FILEDA,2,DEML,0),U,2)
 | 
|---|
 | 43 |  ..I DEMTYPE="d" S Y=DEMVAL X ^DD("DD") S DEMVAL=Y
 | 
|---|
 | 44 |  ..W $E(DEMVAL,1,30)
 | 
|---|
 | 45 |  Q:QAPOUT=1  X:$D(TOF) TOF Q:QAPOUT=1  W !!! K QAPCOL,DEMDA X:$D(TOF) TOF
 | 
|---|
 | 46 |  Q
 | 
|---|
 | 47 |  ;
 | 
|---|
 | 48 | HELPDIS W !,"Enter  a number between  1 and 99999.  You may  use decimals to two",!
 | 
|---|
 | 49 |  W "places if you wish.  If there is a previous value in this field you",!
 | 
|---|
 | 50 |  W "may press RETURN to skip it if you do not wish to change it.",!!
 | 
|---|
 | 51 |  Q
 | 
|---|
 | 52 |  ;
 | 
|---|
 | 53 | TRAP ;suspend and reset during participation for QAPSCRN
 | 
|---|
 | 54 |  LOCK
 | 
|---|
 | 55 |  W !!,*7,"An error has been encountered during your information entry.",!,"Please contact your local IRM for assistance.",!!
 | 
|---|
 | 56 |  W "Your answers entered so far will be saved and your entry given a",!
 | 
|---|
 | 57 |  W """SUSPENDED"" status.  You may resume after the error has been",!,"resolved.",!!,"Press RETURN  " R ANS:DTIME ;if timeout continue to suspend 
 | 
|---|
 | 58 |  S:'$D(QAPCNT) QAPCNT=0 S:'$D(CQUES) CQUES=0 S:'$D(FILEDA) FILEDA=IFN
 | 
|---|
 | 59 |  S (DIC,DIE)="^QA(748.3,",DA=FILEDA,DR="3////s;4////"_QAPCNT_";5////"_CQUES D ^DIE W !!,"Survey suspended, see you later." H 2
 | 
|---|
 | 60 |  D ^%ZISC I '$D(ZTSK),IOST?1"C-VT100"!(IOST?1"C-VT320") S IOTM=1,IOBM=24 W @TOPBOT,@IOF,!
 | 
|---|
 | 61 |  S X="ERR^ZU",@^%ZOSF("TRAP") ;reset to Kernel error trap
 | 
|---|
 | 62 |  G ERR^ZU ;exit via Kernel
 | 
|---|
 | 63 |  ;
 | 
|---|
 | 64 | KANS ;kill unneeded answers
 | 
|---|
 | 65 |  S NDA=DA,NDA1=DA(1) N DA,ANS,X,Y,DIC,DIE
 | 
|---|
 | 66 |  S DA(2)=NDA1,DA(1)=NDA,ANS=""
 | 
|---|
 | 67 |  F  S ANS=$O(^QA(748.25,DA(2),1,DA(1),3,"B",ANS)) Q:ANS=""  F DA=0:0 S DA=$O(^QA(748.25,DA(2),1,DA(1),3,"B",ANS,DA)) Q:DA=""  S DIK="^QA(748.25,DA(2),1,DA(1),3," D ^DIK
 | 
|---|
 | 68 |  K DA,NDA,NDA1 Q
 | 
|---|
 | 69 |  ;
 | 
|---|
 | 70 | DEMSHOW F DAX=0:0 S DAX=$O(^QA(748,SURVEY,1,DEMDA,1,DAX)) Q:DAX=""!(+DAX=0)  S QDTA=^QA(748,SURVEY,1,DEMDA,1,DAX,0),CODE=$P(QDTA,U,1),MEANING=$P(QDTA,U,2) W ?(QAPCOL),CODE," - ",MEANING,!?(QAPCOL)+$L(DEMVAL)+3 X:$D(TOF) TOF S:QAPOUT=1 DAX=999
 | 
|---|
 | 71 |  Q
 | 
|---|