| [613] | 1 | YTEX ;SLC/TGA-EXEMPT TESTS ;9/14/89 14:41 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; Called from the top by MENU option YSEXTESTS
|
|---|
| 5 | ;
|
|---|
| 6 | W @IOF,!!!?22,"EXEMPT PSYCHOLOGY TEST UTILITY"
|
|---|
| 7 | W !!?3,"Tests listed as Psychological Tests in the Mental Health Package"
|
|---|
| 8 | W !?3,"but which do not meet APA guidelines for training can be exempt"
|
|---|
| 9 | W !?3,"by using this utility. All Mental Health professionals have"
|
|---|
| 10 | W !?3,"access to exempt tests."
|
|---|
| 11 | OP ;
|
|---|
| 12 | R !!!?3,"(E)xempt a test, (R)emove exemption, (P)rint list or (Q)uit? Q// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" S A=$TR($E(A_"Q"),"erpq","ERPQ") G END:"Q"[A!YSTOUT!YSUOUT,RE:"R"[A,PR:"P"[A,EX:"E"[A W:A'["?" " ?",$C(7) G OP
|
|---|
| 13 | EX ;
|
|---|
| 14 | S C=0 R !!?3,"Exempt TEST: ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G END:YSTOUT!YSUOUT,OP:A="" I A["?" S YSXT="CLERK^" D ENTB^YTLIST G EX
|
|---|
| 15 | S A=$E(A,1,5),YSTEST=$O(^YTT(601,"B",A,0)) I 'YSTEST W " - NO SUCH TEST!",$C(7) G EX
|
|---|
| 16 | I $P(^YTT(601,YSTEST,0),U,10)["Y" W !!?3,A," is already EXEMPT",! G EX
|
|---|
| 17 | L +^YTT(601,YSTEST) S $P(^YTT(601,YSTEST,0),U,10)="Y",$P(^(0),U,15)=DUZ,^YTT(601,"AE","Y",YSTEST)="" L -^YTT(601,YSTEST) W !!?3,A," is now EXEMPT" G EX
|
|---|
| 18 | RE ;
|
|---|
| 19 | R !!?3,"Remove exemption from TEST: ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G END:YSTOUT!YSUOUT,OP:A="" I A["?" D L G RE
|
|---|
| 20 | S A=$E(A,1,5),YSTEST=$O(^YTT(601,"B",A,0)) I 'YSTEST W " - NO SUCH TEST!",$C(7) G RE
|
|---|
| 21 | I $P(^YTT(601,YSTEST,0),U,10)'["Y" W !!?3,A," was NOT exempt" G RE
|
|---|
| 22 | L +^YTT(601,YSTEST,0) S $P(^YTT(601,YSTEST,0),U,10)="",$P(^(0),U,15)="" K ^YTT(601,"AE","Y",YSTEST) W !!?3,A," is NOT EXEMPT now!" L -^YTT(601,YSTEST,0) G RE
|
|---|
| 23 | PR ;
|
|---|
| 24 | W ! K IOP S %ZIS="Q",YSLFT=0 D ^%ZIS G:POP END I $D(IO("Q")) S ZTRTN="ENP^YTEX",ZTDESC="YS EXEMPT TEST",ZTSAVE("Y*")="" D ^%ZTLOAD G END
|
|---|
| 25 | ENP ;
|
|---|
| 26 | U IO W @IOF,!!!?25,"EXEMPT TESTS",!!?3,"CODE",?11,"TEST NAME",?50,"EXEMPT BY",! S N=0
|
|---|
| 27 | N S N=$O(^YTT(601,"AE","Y",N)) G:N="" E G:'$D(^YTT(601,N,0)) N S X=^(0),I=$P(X,U),T=$P(X,U,9),B=+$P(X,U,15)
|
|---|
| 28 | D:IOST?1"C-".E WAIT^YSUTL:$Y+4>IOSL G:YSLFT END W !?3,I,?10,$S(T'="B":$P($P(^YTT(601,N,"P"),U),"---",2),1:"TEST BATTERY") W:$X>48 ! W ?49,$S($D(^VA(200,B,0)):$P(^(0),U),1:"UNKNOWN") G N
|
|---|
| 29 | E ;
|
|---|
| 30 | W ! D KILL^%ZTLOAD,^%ZISC D:IOST?1"C-".E WAIT^YSUTL G:'$G(ZTSK) OP
|
|---|
| 31 | END ;
|
|---|
| 32 | K A,B,C,I,I0,N,S,T,X,YSLFT,YSTEST,Z,ZTSK Q
|
|---|
| 33 | L ;
|
|---|
| 34 | W !!?15,"EXEMPT TESTS",! S Z=59,T=0
|
|---|
| 35 | L1 ;
|
|---|
| 36 | S T=$O(^YTT(601,"AE","Y",T)) Q:'T G:'$D(^YTT(601,T,0)) L1
|
|---|
| 37 | S Z=Z+8#64 W:Z=3 ! W ?Z,$P(^YTT(601,T,0),U) G L1
|
|---|
