- YTMYER ;SLC/DKG-TEST PKG: MYERS-BRIGGS ;11/4/91 14:59
- ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- ;
- S YSRP=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) F J=1:1:4,7,8 D SCR
- G:YSSX="F" V0 F J=5,6 D SCR
- S R(5)=R(5)+1 G V1
- V0 F J=9,10 D SCR
- S R(5)=R(9),R(6)=R(10)
- V1 S K="" F J=1:1:8 S K=K_R(J)_"^"
- I R(1)>R(2) S YSTY=" E",YSRT=R(1)-R(2)*2-1
- E S YSTY=" I",YSRT=R(2)-R(1)*2+1
- I R(3)>R(4) S YSTY=YSTY_" S",YSRT=YSRT_"^"_(R(3)-R(4)*2-1)
- E S YSTY=YSTY_" N",YSRT=YSRT_"^"_(R(4)-R(3)*2+1)
- I R(5)>R(6) S YSTY=YSTY_" T",YSRT=YSRT_"^"_(R(5)-R(6)*2-1)
- E S YSTY=YSTY_" F",YSRT=YSRT_"^"_(R(6)-R(5)*2+1)
- I R(7)>R(8) S YSTY=YSTY_" J",YSRT=YSRT_"^"_(R(7)-R(8)*2-1)
- E S YSTY=YSTY_" P",YSRT=YSRT_"^"_(R(8)-R(7)*2+1)
- S X=$P(^YTT(601,YSTEST,"P"),"^",1) D DTA^YTREPT W !!?(72-$L(X)\2),X,!! D W30,WI
- S X=" . . . I . . . "
- S T1="EXTRAVERSION^INTROVERSION^ SENSING^INTUITION^ THINKING^FEELING^ JUDGING^PERCEPTIVE" F J=1:1:4 D GRP
- W ! D WI,W30
- I IOST?1"C".E D WAIT G:YSLFT END
- S T1=$E(T1,1,26)_$E(T1,32,49)_$E(T1,54,70)_$E(T1,76,93) W !!!! F J=1:1:4 D TYP
- ;I IOST?1"C".E D WAIT G:YSLFT END
- ;W !!!!!!?25,"--- ITEM RESPONSES ---",!! S YSIT=1,K=10 F I=1:1:12 D RLN
- ;S K=6 D RLN
- END K I,YSIT,J,K,YSKK,L,P,R,YSRP,YSRT,T1,YSTY,W,X,Y,Z Q
- RLN W ?1 F YSKK=1:1:K W $J(YSIT,3,0)," ",$E(YSRP,YSIT)," " S YSIT=YSIT+1
- W ! Q
- SCR S R(J)=0,Y=^YTT(601,YSTEST,"S",J,"K",1,0)
- F Z=1:1 S YSIT=$P(Y,",",Z) Q:YSIT="" S L=$L(YSIT),W=$E(YSIT,L),P=$E(YSIT,L-1),YSIT=+YSIT S:$E(YSRP,YSIT)=P R(J)=R(J)+W
- Q
- W30 W !?16,"60 40 20 0 20 40 60" Q
- WI W !?17,"I I I I I I I" Q
- GRP S L=$P(YSRT,"^",J)+3\4 I "INFP"[$E(YSTY,J*2) S L=L+23+$S(L>15:3,L>10:2,L>5:1,1:0) G G1
- S L=23-L-$S(L>15:3,L>10:2,L>5:1,1:0)
- G1 S Y=$E(X,1,L-1)_"X"_$E(X,L+1,45),L=2*J-1
- W !!?1,$P(T1,"^",L),Y,$P(T1,"^",L+1) Q
- TYP S L=2*J,K=$E(YSTY,L) S:"ESTJ"[K L=L-1
- W !!?26,K," ",$P(T1,"^",L),?41,$J($P(YSRT,"^",J),5,0) Q
- WAIT F I0=1:1:(IOSL-$Y-2) W !
- ;%%%% READER CALL NEEDED HERE%%%%
- R !,"Press return to continue or ""^"" to escape ",YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" I YSTOUT!YSUOUT S YSLFT=1 W @IOF Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMYER 2161 printed Jan 18, 2025@03:19 Page 2
- YTMYER ;SLC/DKG-TEST PKG: MYERS-BRIGGS ;11/4/91 14:59
- +1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- +2 ;
- +3 SET YSRP=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
- FOR J=1:1:4,7,8
- DO SCR
- +4 if YSSX="F"
- GOTO V0
- FOR J=5,6
- DO SCR
- +5 SET R(5)=R(5)+1
- GOTO V1
- V0 FOR J=9,10
- DO SCR
- +1 SET R(5)=R(9)
- SET R(6)=R(10)
- V1 SET K=""
- FOR J=1:1:8
- SET K=K_R(J)_"^"
- +1 IF R(1)>R(2)
- SET YSTY=" E"
- SET YSRT=R(1)-R(2)*2-1
- +2 IF '$TEST
- SET YSTY=" I"
- SET YSRT=R(2)-R(1)*2+1
- +3 IF R(3)>R(4)
- SET YSTY=YSTY_" S"
- SET YSRT=YSRT_"^"_(R(3)-R(4)*2-1)
- +4 IF '$TEST
- SET YSTY=YSTY_" N"
- SET YSRT=YSRT_"^"_(R(4)-R(3)*2+1)
- +5 IF R(5)>R(6)
- SET YSTY=YSTY_" T"
- SET YSRT=YSRT_"^"_(R(5)-R(6)*2-1)
- +6 IF '$TEST
- SET YSTY=YSTY_" F"
- SET YSRT=YSRT_"^"_(R(6)-R(5)*2+1)
- +7 IF R(7)>R(8)
- SET YSTY=YSTY_" J"
- SET YSRT=YSRT_"^"_(R(7)-R(8)*2-1)
- +8 IF '$TEST
- SET YSTY=YSTY_" P"
- SET YSRT=YSRT_"^"_(R(8)-R(7)*2+1)
- +9 SET X=$PIECE(^YTT(601,YSTEST,"P"),"^",1)
- DO DTA^YTREPT
- WRITE !!?(72-$LENGTH(X)\2),X,!!
- DO W30
- DO WI
- +10 SET X=" . . . I . . . "
- +11 SET T1="EXTRAVERSION^INTROVERSION^ SENSING^INTUITION^ THINKING^FEELING^ JUDGING^PERCEPTIVE"
- FOR J=1:1:4
- DO GRP
- +12 WRITE !
- DO WI
- DO W30
- +13 IF IOST?1"C".E
- DO WAIT
- if YSLFT
- GOTO END
- +14 SET T1=$EXTRACT(T1,1,26)_$EXTRACT(T1,32,49)_$EXTRACT(T1,54,70)_$EXTRACT(T1,76,93)
- WRITE !!!!
- FOR J=1:1:4
- DO TYP
- +15 ;I IOST?1"C".E D WAIT G:YSLFT END
- +16 ;W !!!!!!?25,"--- ITEM RESPONSES ---",!! S YSIT=1,K=10 F I=1:1:12 D RLN
- +17 ;S K=6 D RLN
- END KILL I,YSIT,J,K,YSKK,L,P,R,YSRP,YSRT,T1,YSTY,W,X,Y,Z
- QUIT
- RLN WRITE ?1
- FOR YSKK=1:1:K
- WRITE $JUSTIFY(YSIT,3,0)," ",$EXTRACT(YSRP,YSIT)," "
- SET YSIT=YSIT+1
- +1 WRITE !
- QUIT
- SCR SET R(J)=0
- SET Y=^YTT(601,YSTEST,"S",J,"K",1,0)
- +1 FOR Z=1:1
- SET YSIT=$PIECE(Y,",",Z)
- if YSIT=""
- QUIT
- SET L=$LENGTH(YSIT)
- SET W=$EXTRACT(YSIT,L)
- SET P=$EXTRACT(YSIT,L-1)
- SET YSIT=+YSIT
- if $EXTRACT(YSRP,YSIT)=P
- SET R(J)=R(J)+W
- +2 QUIT
- W30 WRITE !?16,"60 40 20 0 20 40 60"
- QUIT
- WI WRITE !?17,"I I I I I I I"
- QUIT
- GRP SET L=$PIECE(YSRT,"^",J)+3\4
- IF "INFP"[$EXTRACT(YSTY,J*2)
- SET L=L+23+$SELECT(L>15:3,L>10:2,L>5:1,1:0)
- GOTO G1
- +1 SET L=23-L-$SELECT(L>15:3,L>10:2,L>5:1,1:0)
- G1 SET Y=$EXTRACT(X,1,L-1)_"X"_$EXTRACT(X,L+1,45)
- SET L=2*J-1
- +1 WRITE !!?1,$PIECE(T1,"^",L),Y,$PIECE(T1,"^",L+1)
- QUIT
- TYP SET L=2*J
- SET K=$EXTRACT(YSTY,L)
- if "ESTJ"[K
- SET L=L-1
- +1 WRITE !!?26,K," ",$PIECE(T1,"^",L),?41,$JUSTIFY($PIECE(YSRT,"^",J),5,0)
- QUIT
- WAIT FOR I0=1:1:(IOSL-$Y-2)
- WRITE !
- +1 ;%%%% READER CALL NEEDED HERE%%%%
- +2 READ !,"Press return to continue or ""^"" to escape ",YSLFT:DTIME
- SET YSTOUT='$TEST
- SET YSUOUT=YSLFT["^"
- IF YSTOUT!YSUOUT
- SET YSLFT=1
- WRITE @IOF
- QUIT