89 lines
4.0 KiB
Mathematica
89 lines
4.0 KiB
Mathematica
YSCEN3 ;ALB/ASF-MH CENSUS LOOKUPS BY UNIT ;3/30/90 14:29 ;11/18/93 08:44
|
|
;;5.01;MENTAL HEALTH;**3**;Dec 30, 1994
|
|
;
|
|
ENPROB ; Called from MENU option YSCENPROB
|
|
;
|
|
K YSOPT1,YSOPT2 D A Q:Y<1!(POP) I $D(IO("Q")) S ZTRTN="PROBQ^YSCEN3" D OUT G END
|
|
PROBQ ;
|
|
D FS U IO W @IOF S P1=1,YSOPT1="PROB^YSCEN3",YSOPT1L="Short Problem Lists",YSLFT=0 K ^UTILITY($J) D:T6'="A" L2^YSCEN2,L3^YSCEN2 D:T6="A" L1^YSCEN2 G END
|
|
;
|
|
ENCN ; Called from MENU option YSCENCRISIS
|
|
;
|
|
K YSOPT1,YSOPT2 D LDT G:Y<1 END D A G:Y<1!(POP) END I $D(IO("Q")) S ZTRTN="CNQ^YSCEN3" D OUT G END
|
|
CNQ ;
|
|
U IO D FS S (P,P1,Q3)=0,YSOP="+",YSTY="CN",YSTLL="Crisis Notes and Messages",YSOPT2="ENPN1^YSCEN3",YSP0=$S(IOST?1"P".E:1,1:0) D:T6'="A" L2^YSCEN2 D:T6="A" L1^YSCEN2 G END0
|
|
;
|
|
ENPN1 ; Prints Crisis Notes and Messages
|
|
; Originally, called PN2^YSCEN33 if not a progress note type,
|
|
; and PT1^YSCEN38 if a progress note.
|
|
; Now, there is no longer a YSCEN38 routine.
|
|
; Note: When calling here, YSN3 = Pt Name, and
|
|
; ^UTILITY($J,YSN3,YSDFN)=Mental Health Inpt file's IEN
|
|
;
|
|
QUIT:$G(Q3) ;->
|
|
N YSN3,YSDFN
|
|
S YSN3=0
|
|
F S YSN3=$O(^UTILITY($J,YSN3)) QUIT:YSN3']""!($G(Q3)) D
|
|
. S YSDFN=0
|
|
. F S YSDFN=$O(^UTILITY($J,YSN3,YSDFN)) QUIT:YSDFN'>0 D ^YSCEN33
|
|
QUIT
|
|
;
|
|
ENDIAG ; Called from MENU option YSCENDIA
|
|
;
|
|
K YSOPT1,YSOPT2 D A Q:Y<1 I $D(IO("Q")) S ZTRTN="DIAGQ^YSCEN3" D OUT G END
|
|
DIAGQ ;
|
|
D FS S YSP0=$S(IOST?1"P".E:6,1:4) U IO W @IOF S YSOPT1="DXLS^YSDX3RUA,DX^YSDX3RU,AX4^YSDX3RUA:YSLFT'=1,AX5^YSDX3RUA:YSLFT'=1,DIAGQ2^YSCEN3",(P,P1)=1,YSOPT1L="ACTIVE DSM/ICD9 DIAGNOSIS",YSTY="ACT",YSLFT=0,YSCENN=1 K ^UTILITY($J)
|
|
S Y1=0,YST=$S(IOST?1"P".E:9,1:0),YSSL=$S(YST:8,1:6),YSLFT=0,YSNOFORM=1
|
|
D:T6'="A" L2^YSCEN2,L3^YSCEN2 D:T6="A" L1^YSCEN2 G END0
|
|
DIAGQ2 ;
|
|
; Modified 11/18/93 to move DSM code to YSDX* area / LJA
|
|
D DIAGQ2^YSDX0002
|
|
QUIT
|
|
;
|
|
ENDRG ;
|
|
K YSOPT1,YSOPT2 D A Q:Y<1!(POP) I $D(IO("Q")) S ZTRTN="DRGQ^YSCEN3" D OUT G END
|
|
DRGQ ;
|
|
D FS U IO W @IOF S YSDRGFL=0,YSN1="X",YSOPT1="^YSCEN32",(P,P1)=1,YSOPT1L="Diagnostic Related Groups" K ^UTILITY($J) D:T6'="A" L2^YSCEN2,L3^YSCEN2 D:T6="A" L1^YSCEN2 G END0
|
|
ENTLST ;
|
|
K YSOPT1,YSOPT2 D A G:Y<1!(POP) END I $D(IO("Q")) S ZTRTN="TLSTQ^YSCEN3" D OUT G END
|
|
TLSTQ ;
|
|
D FS U IO W @IOF S P1=1,YSOPT1="REC^YSCEN41",YSOPT1L="RECENT PSYCHOLOGICAL TESTS & INTERVIEWS" D:T6'="A" L2^YSCEN2,L3^YSCEN2 D:T6="A" L1^YSCEN2 G END0
|
|
ENALLT ;
|
|
K YSOPT1,YSOPT2 S YSCENN=1 D A G:Y<1 END I $D(POP) G:POP END
|
|
I $D(IO("Q")) S ZTRTN="ALLTQ^YSCEN3" D OUT G END
|
|
ALLTQ ;
|
|
D FS U IO W @IOF S P1=1,YSOPT1="EN^YSCEN41",YSOPT1L="ALL TESTS AND INTERVIEWS" D:T6'="A" L2^YSCEN2,L3^YSCEN2 D:T6="A" L1^YSCEN2 G END0
|
|
PROB ;
|
|
S P4="PL",F3=0,YSSL=1 D EN1^YSPROB5,WAIT^YSCEN1 Q
|
|
;
|
|
A ; Called by routines YSCEN2, YSCEN23, YSCEN31, YSCEN34, YSCEN35
|
|
K IOP
|
|
A1 ; Called by routine YSCEN1
|
|
;
|
|
S Y=-1 R !,"Sort by (W)ard/team or (S)taff? W// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" Q:YSTOUT!YSUOUT S X=$TR(X_"W","ws","WS") G:X?1"S".E WHO^YSCEN26 I X'?1"W".E W !,"Please select either <<W>>ard or <<S>>taff",$C(7) G A1
|
|
;
|
|
AX ; Called by routines YSCEN39, YSCEN4, YSCEN8
|
|
;
|
|
S POP="" K ^UTILITY($J) D UN^YSCEN2 Q:Y<1 S (Q3,P1)=0
|
|
I '$D(^YSG("INP","AWC",+Y)) W !,"No patients are listed on this ward",!,$C(7) H 3 G A
|
|
S W4=$P(^YSG("CEN",W1,0),U,9) I $P(^YSG("CEN",W1,0),U,8) S Y=1,T6=W4,%ZIS="Q" D ^%ZIS Q
|
|
A0 ;
|
|
S Y=0 W !,"Select ",W2," Team: " R X:DTIME S YSTOUT='$T,YSUOUT=X["^" Q:YSTOUT!YSUOUT I X="ALL"!(X="all")!(X="All") S T6="A",Y=1,%ZIS="Q" D ^%ZIS Q
|
|
I X?1"^".E S Y=-1,POP=1 Q
|
|
S DIC("S")="I $P(^(1),U)=W1,$P(^(1),U,5)'=1",DIC(0)="EQM",DIC="^YSG(""SUB""," D ^DIC K DIC W:X="?" !,"Enter 'ALL' for all teams",! G:Y<1 A0
|
|
I '$D(^YSG("INP","AWC",W1,+Y)) W !,"No patients are listed for this team",!,$C(7) G A0
|
|
S T6=+Y I '$D(TYPE) S %ZIS="Q" D ^%ZIS Q:POP
|
|
Q
|
|
END0 ;
|
|
D KILL^%ZTLOAD
|
|
END ;
|
|
G ^YSCEN37
|
|
FS ;
|
|
I $D(W1),W1 S P1=0 D FS0^YSCEN Q
|
|
Q
|
|
LDT ;
|
|
S %DT("A")="LISTING FROM WHICH DATE? ",%DT="AEQP" D ^%DT S YSLDTY=+Y,YSLDT=9999999-+Y K %DT Q
|
|
OUT ;
|
|
K IO("Q") S ZTDESC="LOOKUP "_ZTRTN F ZZ="W1","W2","Q3","T6","YSLDT","YSCR","YSWHO" S ZTSAVE(ZZ)="",ZTDESC="YS IP UNIT LKUP"
|
|
D ^%ZTLOAD W !,$S($D(ZTQUEUED):"QUEUED",1:"Not queued"),$C(7)
|