source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTEX.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1YTEX ;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."
11OP ;
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
13EX ;
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
18RE ;
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
23PR ;
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
25ENP ;
26 U IO W @IOF,!!!?25,"EXEMPT TESTS",!!?3,"CODE",?11,"TEST NAME",?50,"EXEMPT BY",! S N=0
27N 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
29E ;
30 W ! D KILL^%ZTLOAD,^%ZISC D:IOST?1"C-".E WAIT^YSUTL G:'$G(ZTSK) OP
31END ;
32 K A,B,C,I,I0,N,S,T,X,YSLFT,YSTEST,Z,ZTSK Q
33L ;
34 W !!?15,"EXEMPT TESTS",! S Z=59,T=0
35L1 ;
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
Note: See TracBrowser for help on using the repository browser.