65 lines
3.4 KiB
Mathematica
65 lines
3.4 KiB
Mathematica
YSCEN4 ;ALB/ASF-TEST SEARCH/BY TEAM ;4/3/90 10:30 ;
|
|
;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|
;
|
|
; Called from the top by MENU option YSCENTESTING
|
|
;
|
|
CH ; Called by routine YSCEN41
|
|
;
|
|
S YSTS="" R !,"(A)ll tests,(R)ecent tests",!,"(C)ustom battery,(S)tandard battery or (H)elp? S// ",L:DTIME S YSTOUT='$T,YSUOUT=L["^" G:YSTOUT!YSUOUT END S:L?1"?".E L="H"
|
|
S L=$E(L),L=$TR(L,"arcsh","ARCSH") G CH:"ARCSH"'[L S L=$S(L="A":"ENALLT^YSCEN3",L="C":"RD1",L="R":"ENTLST^YSCEN3",L="H":"INS^YSCEN41",1:"LP") G @L
|
|
RD1 ;
|
|
R !," Test/interview for search : ",YSTS1:DTIME S YSTOUT='$T,YSUOUT=YSTS1["^" G:YSTOUT!YSUOUT END G LP:YSTS1="" I YSTS1["?" D RDQ G RD1
|
|
D:YSTS1?.E1L.E RDL I '$D(^YTT(601,"B",YSTS1)) W $C(7),!,"NO SUCH TEST/INTERVIEW" G RD1
|
|
S YSTS=YSTS_YSTS1_"^" G RD1
|
|
RDQ ;
|
|
S Z=59,YSNX="",I="" W !!?21,"--- LIST OF TESTS ---",!
|
|
L1 S I=$O(^YTT(601,"AI","T",I)) G:'I INT S X=^YTT(601,I,0) G:$P(X,U,13)="N" L1 S X2=$P(X,U,14),X2=$S(X2="N":"*",1:"")
|
|
S YSNX=$P(X,U)_$S(X2="*":"*",1:"") S Z=Z+8#64 W:Z=3 ! W ?Z,YSNX G L1
|
|
INT ;
|
|
S I=0,Z=59,YSLFT=0,IOP=0 D ^%ZIS K IOP D:IOST?1"C-".E WAIT^YSUTL G:YSLFT INE W !!?19,"--- LIST OF INTERVIEWS ---",!
|
|
L2 ;
|
|
S I=$O(^YTT(601,"AI","I",I)) I I S X=^YTT(601,I,0) G:$P(X,U,13)="N" L2 S Z=Z+8#64 W:Z=3 ! W ?Z,$P(^(0),U) G L2
|
|
INE ;
|
|
W ! K I,X,X2,YSNX,Z Q
|
|
RDL ;
|
|
F ZZ=1:1:$L(YSTS1) I $E(YSTS1,ZZ)?1L S D=$E(YSTS1,ZZ),D=$A(D)-32,YSTS1=$E(YSTS1,0,ZZ-1)_$C(D)_$E(YSTS1,ZZ+1,30)
|
|
Q
|
|
LP ;
|
|
R !,"Display (A)ll or (L)ast date: L// ",YSALL:DTIME S YSTOUT='$T,YSUOUT=YSALL["^" G:YSTOUT END
|
|
S YSR1="YSALL",YSR2="L",YSR3="AL" D ^YSCEN14 G END:YSALL=-1,LP:YSALL="?"
|
|
W ! D AX^YSCEN3 G:Y<1!(POP) END I $D(IO("Q")) K IO("Q") S ZTRTN="LPQ^YSCEN4",ZTDESC="YS IP TT",(ZTSAVE("T6"),ZTSAVE("W1"),ZTSAVE("W2"),ZTSAVE("YSALL"),ZTSAVE("YSTS"))="" D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
|
|
LPQ ;
|
|
U IO S P1=0,YSOPT2="LP1^YSCEN4",YSOPT1L="PSYCHOLOGICAL TESTS & INTERVIEWS" D FS0^YSCEN D:T6'="A" L2^YSCEN2 D:T6="A" L1^YSCEN2
|
|
D KILL^%ZTLOAD
|
|
END ;
|
|
K ZTSK,^UTILITY($J),YSOPT2,YSOPT1,Z,S,T6,T5,W1,W2,C1,DIC,DIK,YSALL,C,YSDATE,YSDAY,YSDFN,I,L,N,N8,P1,S,YSTS,YSTS1,YSTST,Z4,DIYS,Q3,R,W4,X,X1,Y,YSET,YSTM,YSTY,YSLFT D ^%ZISC Q
|
|
LP1 ;
|
|
D:YSTS="" STAN I YSTS="" W:T6?1N.N !!,$C(7),"NO STANDARD BATTERY DEFINED FOR ",$P(^YSG("SUB",T6,0),U) H 1 Q
|
|
W @IOF D LABEL S C=0,N8="",Q3=0 F S N8=$O(^UTILITY($J,N8)) Q:N8=""!Q3 D S0
|
|
D:IOST?1"C-".E WAIT^YSCEN1 Q
|
|
S0 ;
|
|
S YSDFN=0 F S YSDFN=$O(^UTILITY($J,N8,YSDFN)) Q:'YSDFN D S1
|
|
Q
|
|
;
|
|
S1 ;
|
|
S C=C+1 W !,$J(C,3)," ",$P(^DPT(YSDFN,0),U),?29," " D LK
|
|
Q
|
|
;
|
|
LK ;
|
|
F ZZ=1:1 Q:$P(YSTS,U,ZZ)="" S YSDAY=0,N=0,YSTST=$P(YSTS,U,ZZ),YSET=$O(^YTT(601,"B",YSTST,0)) D SEARCH
|
|
Q
|
|
SEARCH ;
|
|
I '$D(^YTD(601.2,YSDFN,1,YSET)) W:$X>70 !?30 W " ",$J(YSTST,4)," XXXXXXXX" W:YSALL'?1"A".E "X " Q
|
|
G SALL:YSALL?1"A".E
|
|
SL ;
|
|
S YSDAY=$O(^YTD(601.2,YSDFN,1,YSET,1,YSDAY)) S:YSDAY YSDATE=YSDAY,N=N+1 W:$X>70 !?30 W:YSDAY<1 " ",$J(YSTST,4)," ",$$FMTE^XLFDT(YSDATE,"5ZD"),$C(N+96)," " G SL:YSDAY>1 Q
|
|
SALL ;
|
|
S YSDAY=$O(^YTD(601.2,YSDFN,1,YSET,1,YSDAY)) Q:'YSDAY S YSDATE=YSDAY W:$X>70 !?30 W " ",$J(YSTST,4)," ",$$FMTE^XLFDT(YSDATE,"5ZD") G SALL
|
|
LABEL ;
|
|
S T5=$S(T6?1N.N:$P(^YSG("SUB",T6,0),U),1:"UNNASSIGNED")
|
|
W !!!,$$FMTE^XLFDT(DT,"5ZD")," Ward: ",W2," team: ",T5 Q:T6="UN"
|
|
S Z4=^YSG("SUB",T6,0) W:$P(Z4,U,2)]"" !,"PHYSICIAN: ",$P(^VA(200,$P(Z4,U,2),0),U) W:$P(Z4,U,3)]"" ?45,"PSYCHOLOGIST: ",$P(^VA(200,$P(Z4,U,3),0),U) Q
|
|
STAN ;
|
|
S YSTS="",YSTY="",Z=0 F S Z=$O(^YSG("SUB",T6,"TEST",Z)) Q:'Z S YSTS1=$P(^(Z,0),U),YSTS=YSTS_YSTS1_U
|
|
Q
|