Пси тест СМЕ

set proc to PsyHelp
do InitSet

select A
use PsyHelp
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
PUBLIC Pass,Pass1
PUBLIC TmpAnswer,NoTests

NoTests = 19

PUBLIC Pass2

PUBLIC Pscal(12),Sscal(12),VOnScal(13),vt_koeff(58),vt_ball(58)   && BҐЈҐв вЁў­
PUBLIC VOans(58),kol(9),domin,sym(3),ZakVO(3),AnsVO             && ®Їа®б­ЁЄ
PUBLIC SumPST,SumST
       SumPST=44.60
       SumST =39.80

Pass1=upper("sme")

PUBLIC VOGkoef(74),  VOGball(74),  VO2ans(74)           && ‚Ћ + ѓЁбᥭ
PUBLIC GisNamScal(5), GissNo(4,6), GisVeg(24) && ‚Ћ + ѓЁбᥭ
PUBLIC VOGans(74), GISans(24), GisSum(5)        && ‚Ћ + ѓЁбᥭ

PUBLIC UNPans(90),KYes(90,2),KNo(90,2),UNP(4),ansUNP            && “HЏ
PUBLIC Nevr,Psyh,Lye,LBall,NegBall,zakLye,zakPsyh,zakNevr       && “HЏ
PUBLIC NPlus,NMinus,PPlus,PMinus,TmpUNP1,TmpUNP2                &&

PUBLIC KEIans(70),ansKEI,TmpKEI1,TmpKEI2,Judging,Perceiv        && Keirsi
PUBLIC Extravers,Introvers,Thinking,Feeling,iNtuition,Sensing   && Keirsi
PUBLIC Brightness && Keirsi
PUBLIC TmpKEI1,TmpKEI2                && Keirsi
PUBLIC E_Zakl,I_Zakl,S_Zakl,N_Zakl,T_Zakl,F_Zakl,J_Zakl,P_Zakl  && Keirsi
PUBLIC Zakl_1,Zakl_2,Zakl_3,Zakl_4,DoublSkal0,DoublSkal2        && Keirsi
PUBLIC S_1, S_2, S_3, S_4, TypSymv, NATP                && Keirsi

PUBLIC CTOans(8),Col_Range(8),Rng_Koef(8),Col_No(8)              &&–’Ћ-Ѓ ¦Ё­
PUBLIC Col_Rang(8),CTO_Scal(6),CTOnsc(6),Scal_Min(6),Scal_Max(6) &&Ё Ђ¬Ё­Ґў

PUBLIC USKans(44),PlusUSK(47),MinUSK(47),ansUSK                && “‘Љ
PUBLIC ScalUSK(7),NamScalUSK(7),StanUSK(7)                && “‘Љ

PUBLIC TiDans(20),Anxiety,Depression,ansTiD                &&’Ё„
PUBLIC AnxN(10),AnxK1(10),AnxK2(10),AnxK3(10),AnxK4(10),AnxK5(10) &&’Ё„
PUBLIC
PUBLIC BdAans(75),BdAScal(10),BdANamScal(10),ansBdA               && Ѓ-¤'Ђ
PUBLIC BdANoScal(75),BdAnsKoef(75)                && Ѓ-¤'Ђ
PUBLIC TmpBdA1,TmpBdA2                && Ѓ-¤'Ђ

PUBLIC ILSans(97),ILSNamScal(8), ILSNoQ(8), ILScal(8,14)   && ILS
PUBLIC ILSum(8),TmpILS1, TmpILS2   && ILS

PUBLIC TRaMKey(5,5), TRaMScal(5), TRaMNamSc(5), TRaMAns(40)   && ђ жЊли
PUBLIC RaMSum

PUBLIC MLO_K_L(13), MLO_K_AS(2,112), MLO_K_NPU(2,73)              && Њ‹Ћ-Ђ¤ Їв
PUBLIC MLO_K_MN(2,18), MLO_K_KO(2,20), MLOans(165)                && Њ‹Ћ-Ђ¤ Їв
PUBLIC MLO_L, MLO_AS, MLO_NPU, MLO_MN, MLO_KO, MLO_LAP            && Њ‹Ћ-Ђ¤ Їв
PUBLIC TmpMLO1, TmpMLO2, TmpMLO3                && Њ‹Ћ-Ђ¤ Їв
PUBLIC MLOStan(4)

PUBLIC AleAns(26), AleSum   && Alexitimia

PUBLIC ansSoF, SocFru(20), SocFrQu(20), mSSOF      && Soc Frustr

PUBLIC ansHOR, HORAns(43), HORKoef(43), mSSTRE   && Holms & Reich

PUBLIC OlMKey(14,9), OlMNamScal(2,14), OlMScal(14), OlMans(107)   && Ћ«¤ен¬-Њ®а
PUBLIC OlMNo(14), TmpOlM1, TmpOlM2                && Ћ«¤ен¬-Њ®а


PUBLIC SPAKey(14,34), SPANamScal(14), SPAScal(14), SPAans(101) && ‘ЏЂ
PUBLIC SPAmin(14), SPAmax(14), SPANoQ(16), TmpSPA1, TmpSPA2 && ‘ЏЂ
PUBLIC SPAdapt, SPASPri, SPAPriO, SPAEmoC, SPAInt, SPADom  && ‘ЏЂ

PUBLIC KOCMinus(2,10),KOCPlus(2,10),KOCAns(40), mCOM, mORG && KOC-2

PUBLIC IDRAns(15), mIDR                && џ-ᮮ⢥вбвўЁҐ


PUBLIC Weight,Height,OGK                && FS - Baevsky
PUBLIC Pulse1,ADsys1,ADdias1,Breath1               && FS - Baevsky
PUBLIC Pulse2,ADsys2,ADdias2,Breath2               && FS - Baevsky
PUBLIC FS,AdapGr,AdapState(4)                && FS - Baevsky

Pass2=upper("tdk")

PUBLIC FIO_,Sex_,Age_,BrnYear_,DatObsl_,Otdel_,NoObsl_
PUBLIC Educ_,BegSr_,FinFre_,MAIL_

PUBLIC ToScreen,ToPrint,ToFile,Write,Korr,ArcData,AnsField
PUBLIC Primary,Secondary,RepNotSave

PUBLIC SubDir,BDName,ProcNam,regim,regim1,FilOut
PUBLIC Test,TestNo,INITINPROC,INITPROC,VVODPROC,ANALPROC,PRNTPROC
PUBLIC SAVEPROC,SCATPROC,ANS

* Append from File
PUBLIC PUBLIC mANSWSOF, mANSWRAM, mANSWALE, mANSWOLM, mANSWUNP,mANSWMLO
PUBLIC mField,mTRE, mDEP, mANSWSPA, mANSWHOR, NRec1, NRec2, FldName

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
 ®"+CHR(10)+;
"¬ « п ®ЎйЁвҐ«м­®бвм."
* -------  S/N  -------
S_Zakl="S:Їа ЄвЁз­®бвм, ў®ў«ҐзҐ­­®бвм ў ®Єаг¦ ойго бЁвг жЁо (§¤Ґбм Ё ᥩз б), ®Ї®а "+CHR(10)+;
"­  б®Ўб⢥­­л©  ®Їлв  Ё  §¤а ўл© б¬лб«,  ®аЁҐ­в жЁп ­  ®ЎйҐЇаЁ­п⮥ ¬­Ґ­ЁҐ"
N_Zakl="N:®Ї®а  ­  Ё­вгЁжЁо, вў®азҐбвў®, ®¤­ Є® § з бвго б®зҐв ой пбп б ­ҐЄ®в®а®©"+CHR(10)+;
"®в®аў ­­®бвмо ®в ॠ«м­®бвЁ, ­Ґ¤®бв в®з­®© Їа ЄвЁз­®бвмо"
* -------  T/F  -------
T_Zakl="T:®аЁҐ­в жЁп  ў ЇаЁ­пвЁЁ аҐиҐ­Ё© ў ЇҐаўго ®зҐаҐ¤м ­  «®ЈЁзҐбЄЁ© а бзҐв,   ­Ґ"+CHR(10)+;
"«Ёз­лҐ ®в­®иҐ­Ёп,  н¬®жЁ®­ «м­ п  ®вбва ­Ґ­­®бвм ў ®в­®иҐ­Ёпе б «о¤м¬Ё."
F_Zakl="F:®аЁҐ­в жЁп  ў ЇаЁ­пвЁЁ аҐиҐ­Ё© ў Ў®«м襩 ¬ҐаҐ ­  祫®ўҐзҐбЄЁҐ ў§ Ё¬®®в­®иҐ­Ёп,"+CHR(10)+;
"  ­Ґ «®ЈЁзҐбЄЁ© а бзҐв, н¬®жЁ®­ «м­ п ў®ў«ҐзҐ­­®бвм ў ®в­®иҐ­Ёпе б «о¤м¬Ё."
* -------  J/P  -------
J_Zakl="J:®аЈ ­Ё§®ў ­­®бвм,  ¬Ґв®¤Ёз­®бвм, б«Ґ¤®ў ­ЁҐ  § ¤ ­­®¬г ¦Ё§­Ґ­­®¬г  Ї« ­г,"+CHR(10)+;
"бв६«Ґ­ЁҐ  Є Ї« ­Ёа®ў ­Ёо,  ®ЇаҐ¤Ґ«Ґ­­®бвЁ, Ї®бв®п­бвўг"
P_Zakl="P:ЇаҐ¤Ї®зЁв ­ЁҐ Ї®бв®п­­®© бў®Ў®¤л ўлЎ®а ,бЇ®­в ­­®бвм,ЈЁЎЄ®бвм, ­ҐЇ®бв®п­бвў®,"+CHR(10)+;
"­ҐЇаҐ¤бЄ §гҐ¬®бвм, ®вбгвбвўЁҐ Ї« ­Ёа®ў ­Ёп, Є®«ҐЎ ­Ёп а Ў®в®бЇ®б®Ў­®бвЁ"

RETURN


*                KEIVVOD                *

PROCEDURE KEIVVOD
    *do Init
    set device to screen

    @ 03,00 clear to 22,60
    @ 03,00 to 22,60    &&double
    @ 04,05 say "Џа®в®Є®« вҐбв  ЉҐ©абЁ: " + Test
    do AnkScreen with 05,05
    @ 10,5 say "‚ўҐ¤ЁвҐ ®вўҐвл  (ЎгЄўл < >, <Ў>  /Ё«Ё Їа®ЎҐ«л) "
    @ 12,5 say "1        10        20        30   35"
    @ 13,5 say ":___:____:____:____:____:____:____:"
    @ 14,5 get TmpKEI1 pict "@R###################################"
    READ
    ?? chr(7)+chr(7)
    *@ 16,2 clear to 18,74
    @ 16,5 say "36  40        50        60        70"
    @ 17,5 say ":___:____:____:____:____:____:____:"
    @ 18,5 get TmpKEI2 pict "@R###################################"
    READ
    clear gets
    ?? chr(7)+chr(7)

* STUFF(Var1,BeginNo,NoOfChars,Var2)
    TmpAnswer = STUFF(TmpAnswer,1,35,TmpKEI1)
    TmpAnswer = STUFF(TmpAnswer,36,35,TmpKEI2)
RETURN



PROCEDURE KEIANAL
PRIVATE Tmp,TmpAdd,ii

do CntStatus with "ЉҐ©абЁ"
*******************
   ansKEI=TmpAnswer

if LEN(RTRIM(ansKEI))<70        && HҐЇ®«­®бвмо ўўҐ¤Ґ­л ¤ ­­лҐ
   do ErrAnal
   RETURN
endif

   ii=1
   do while ii<=70
      Tmp=SUBSTR(ansKEI,ii,1)
      ? tmp
      do case
* case UPPER(Tmp)="Ђ".or.UPPER(Tmp)="A"
      case    && rus+lat
           KEIans(ii)=1
      case            KEIans(ii)=2
      otherwise
   endcase
   ?? keians(ii)
   ii=ii+1
   enddo
wait



PROCEDURE SoFANAL
do CntStatus with "SocFru"
*************  check answers               

AleSum = 0
store 0 to SocFru

if LEN(RTRIM(TmpAnswer))<20        && HҐЇ®«­®бвмо ўўҐ¤Ґ­л ¤ ­­лҐ
    ? "   tmp answ",tmpAnswer
    wait
   do ErrAnal
   RETURN
endif


i=1
do while i<= 20
   store SUBSTR(TmpAnswer,i,1) to anstxt   
         if VAL(anstxt)>=1.and.VAL(anstxt)<=5
            SocFru(i) = VAL(anstxt)
         else
    ? "i=",i,"   ... answ",SocFru(i)
    wait
    do ErrAnal
         endif
   i=i+1
enddo

i=1
do while i<= 20
   mSSOF = mSSOF + SocFru(i)
   i=i+1
enddo

RETURN


PROCEDURE SoFPRNT

@ 02,00 clear to 24,79
if ToScreen
  @ 02,05 say "Џа®в®Є®«  вҐбвЁа®ў ­Ёп  ‘®ж ”"
  @ 02,40 say FIO_ pict "@R  ЋЎб«Ґ¤гҐ¬л©: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
else
  @ 00,05 say  "Џа®в®Є®«  вҐбвЁа®ў ­Ёп  ‘®ж ”"
  do AnkType
endif

    @ 04,5 say i=1   
do while i<=10
    @ 05+i,01 say LEFT(SocFrQu(i),35) + ": " + IIF(SocFru(i)>1,STR(SocFru(i),1)," ")
    @ 05+i,40 say LEFT(SocFrQu(i+10),35) + ": " + IIF(SocFru(i+10)>1,STR(SocFru(i+10),1)," ")
    i= i+1
enddo
    @ 17,5 say
    @ 19,5 say "ЋЎй п бг¬ : "  + STR(mSSOF,3)

    if ToScreen
       do CntOut
    else
       ? "Ља вЄЁҐ Ї®пб­Ґ­Ёп"
    endif
R   

PROCEDURE HORPRNT

@ 02,00 clear to 24,79
if ToScreen
  @ 02,05 say "Џа®в®Є®«  вҐбвЁа®ў ­Ёп •®«¬б  Ё ђҐ©е "
  @ 02,40 say FIO_ pict "@R  ЋЎб«Ґ¤гҐ¬л©: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
else
  @ 00,05 say  "Џа®в®Є®«  вҐбвЁа®ў ­Ёп •®«¬б  Ё ђҐ©е "
  do AnkType
endif

    @ 04,5 say    
    @ 06,5 say "Џ®«г祭­ п  б㬬 :   " + STR(mSSTRE,3)

    @ 08,5 say
    if ToScreen
       do CntOut
    else
       ? "Ља вЄЁҐ Ї®пб­Ґ­Ёп"
    endif
RETURN


PROCEDURE HORScat
     TmpAnswer = A->ANSWHOR
     mSSTRE    = A->SSTRE
RETURN