90 lines
4.4 KiB
Mathematica
90 lines
4.4 KiB
Mathematica
YSCEN2 ;ALB/ASF-MH CENSUS PATIENT LIST ;4/16/92 09:53 ;08/13/93 15:48
|
|
;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|
UN ;
|
|
; called routines YSCEN1, YSCEN13, YSCEN21, YSCEN22, YSCEN24, YSCEN3,
|
|
; YSCEN51, YSCEN52, YSCEN61, YSCEN7, YSCEN8, YSCEN81
|
|
N DIC
|
|
S DIC="^YSG(""CEN"",",DIC(0)="AEQZM",DIC("A")="Select Inpatient Ward: ",DIC("S")="I '$P(^(0),U,13)" D ^DIC K DIC("S") Q:Y<1 S W1=+Y,W2=Y(0,0) K Y(0),Y(0,0)
|
|
Q
|
|
L1 ; called by ENQ and routines YSCEN1, YSCEN13, YSCEN22, YSCEN31
|
|
; YSCEN34 ,YSCEN39, YSCEN4, YSCEN5, YSCEN55, YSCEN6, YSCEN61, YSCEN8
|
|
S (Q3,T6,C2)=0,W2=$P(^DIC(42,W1,0),U) S:'$D(P1) P1=1
|
|
F S C2=$O(^YSG("SUB","AOR",W1,C2)) Q:'C2 S T6=$O(^(C2,0)) Q:'T6 K ^UTILITY($J) I '$P($G(^YSG("SUB",T6,1)),U,5) D L2 D:P1 L3,WAIT^YSCEN1:'$D(YSOPT1)!($D(YSCENN)) Q:Q3
|
|
Q
|
|
;
|
|
L2 ; called by L1 and routines YSCEN1, YSCEN21, YSCEN23, YSCEN24, YSCEN3
|
|
; YSCEN31, YSCEN34, YSCEN35, YSCEN39, YSCEN4, YSCEN8
|
|
U IO I $G(T6)="S" G S1^YSCEN26
|
|
S (YSTM,YSDFN,YSDA)=0
|
|
F S YSDA=$O(^YSG("INP","AWC",W1,+T6,YSDA)) Q:'YSDA S YSDFN=$P(^YSG("INP",YSDA,0),U,2),X1=+$G(^DPT("CN",W2,YSDFN)) I X1 S ^UTILITY($J,$P(^DPT(YSDFN,0),U),YSDFN)=YSDA,YSTM=YSTM+1
|
|
D:$D(YSOPT2) @YSOPT2
|
|
Q
|
|
;
|
|
L3 ; Called by routines YSCEN24, YSCEN26, YSCEN3
|
|
;
|
|
D:'$D(YSOPT1)!$D(YSOPT1L) H1 G:'$D(^UTILITY($J)) L8 S N1="A" F S N1=$O(^UTILITY($J,N1)) Q:N1=""!Q3 D L6
|
|
Q
|
|
;
|
|
L6 ;
|
|
S YSDFN=0 F S YSDFN=$O(^UTILITY($J,N1,YSDFN)) Q:'YSDFN D H1:$D(YSOPT1)&(($Y<3)!($Y+5>IOSL)),L7,WAIT^YSCEN1:$D(YSOPT1)&($Y+5>IOSL) Q:Q3
|
|
Q
|
|
;
|
|
L7 ;
|
|
I $Y>(IOSL-5) D WAIT^YSCEN1 Q:Q3 D H1
|
|
D ENPT^YSUTL S DA=^UTILITY($J,N1,YSDFN),G=^YSG("INP",DA,0) W !,YSNM,?30,YSBID,?35,$J(YSAGE,3)
|
|
S X=$P(G,U,3),X(1)=$$FMTE^XLFDT(X,"5ZD") W ?39,X(1)
|
|
I $D(^YSG("INP",DA,1)) S G3=^(1) W $P(G3,U),$P(G3,U,2),$P(G3,U,3)
|
|
S X1=DT,X2=X D ^%DTC W ?50,$J(X,4) S X=$P(G,U,5) W ?56 D:X?1N.N D3 W:$D(^DPT(YSDFN,.101)) ?70,^(.101)
|
|
I $D(YSOPT1) D @YSOPT1
|
|
K G,G3 Q
|
|
L8 ;
|
|
D:$Y<3 H1 W !!,"No patients" Q
|
|
;
|
|
H1 ; Called form routines YSCEN23, YSCEN31
|
|
;
|
|
S YSTLE=$S($D(YSOPT1L):YSOPT1L,1:"PATIENT LIST") W:$Y>1 @IOF W "WARD: ",W2,?$X+(IOM-$X-25-($L(YSTLE))/2),YSTLE D TIME
|
|
I $G(YSOPT9L)]""&($G(YSWHO)>0) W !?3,YSOPT9L,$P(^VA(200,+YSWHO,0),U)
|
|
S G2=^YSG("SUB",T6,0)
|
|
W !,"TEAM: ",$P(G2,U),?20," Beds: ",$P(^YSG("SUB",T6,1),U,3),?35," Patients: ",YSTM S X=$P(G2,U,9) I YSTLE="PATIENT LIST" W !,"Team Leader: " D D3 W ?20," Physician: " S X=$P(G2,U,2) D D3 W ?50," Psychologist: " S X=$P(G2,U,3) D D3
|
|
H12 ;
|
|
W !,"NAME",?30,"SSN",?35,"AGE",?39,"ENTERED",?50,"DAYS",?56,$S(T6?1N.N:$P(^YSG("SUB",T6,0),U,10),1:""),?70,"BED",!
|
|
S C1="",$P(C1,"-",81)="" W C1,!
|
|
Q
|
|
TIME ; Called by routines YSCEN24, YSCEN35, YSCEN39, YSCEN81
|
|
;
|
|
S:$D(YSTM) YSTMX=YSTM K Y D ENDTM^YSUTL W ?57,YSDT(1)," ",YSTM S:$D(YSTMX) YSTM=YSTMX
|
|
Q
|
|
D3 ; Called by routines YSCEN21, YSCEN22, YSCEN23, YSCEN35, YSCEN54
|
|
; YSCEN61, YSCEN8
|
|
;
|
|
Q:X'?1N.N S X=$P(^VA(200,X,0),U),X(2)=$E($P(X,",",2),1,2) S X(2)=$S(X(2)?1P.E:$E(X(2),2),1:$E(X(2))) W " ",$P(X,","),",",X(2)
|
|
Q
|
|
;
|
|
EN ; Called from MENU option YSCENSL
|
|
; Called from MENU option YSCENPATL
|
|
;
|
|
R !!,"Print all wards? N// ",YSOP:DTIME S YSTOUT='$T,YSUOUT=YSOP["^" G:YSTOUT END
|
|
S YSR1="YSOP",YSR2="N",YSR3="YN" D ^YSCEN14 G EN:YSOP="?",END:YSOP=-1,ENALL:YSOP="Y"
|
|
EN1 ;
|
|
D A^YSCEN3
|
|
G:Y<1!($G(POP))!(YSTOUT)!(YSUOUT) END
|
|
I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^YSCEN2",ZTDESC="YS IP" F YSJ="T6","P1","W1","W2","Q3","YSWHO","YSCR" S ZTSAVE(YSJ)=""
|
|
I D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
|
|
ENQ ;
|
|
D FS0^YSCEN:W1 W @IOF K YSOPT1,YSOPT2 S P1=1 D:T6?1N.N L2,L3 D:T6="S" L2 D:T6="A" L1 K T6 D:IOSL-3>$Y WAIT^YSCEN1
|
|
;
|
|
END0 ; Called by routines YSCEN23, YSCEN24
|
|
D KILL^%ZTLOAD
|
|
END ; Called by routines YSCEN23, YSCEN24, YSCEN31, YSCEN35, YSCEN39, YSCEN8
|
|
;
|
|
K C,D,DIYS,G3,N3,S,V,%Y,Y,Z1,ZTSK,ZTIO,C1,C7,DIE,DIC,DR,DIK,I,I7,N,N1,Q3,R,T6,W2,W4,X1,X2,YSB,YSCR,YSJ,YSOPT9L,YSWHO,YSOP,YSOPT1,YSOPT1L,YSOPT2,W1,YSDFN,YSDOB,YSDTM,YSSEX,YST,I1,I2,L1,L2,L3,L4,A6,S2,S5,YSTB,YSDISP,YSFA
|
|
K YSAC,YSBLN,M,YSAOR,YSC1,YSTLE,YSTMX,YSNM,YSSSN,YSAGE,X,G2,G,F,P,YSCOP,YSCOPY,YSF4,YSPDX,A5,J,L,T,YSENT,YSG,YSGL1,YSPE,YSPOIN,YSTP,YSTM,YSDOT,YSFHDR,YSIDT,YSPPL,YSPST,YSPSV,YSPY,YSPZ,YSX,YSYDT,Z,YSBID
|
|
K G10,G11,YSFFS,YSDA,YDA,VA D KVAR^VADPT W !! D ^%ZISC
|
|
Q
|
|
ENALL ;
|
|
K IOP,YSOPT1,YSOPT2 S %ZIS="Q" D ^%ZIS G:POP END
|
|
I $D(IO("Q")) K IO("Q") S ZTRTN="ENALQ^YSCEN2",ZTDESC="YS IP",ZTIO=IO D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
|
|
ENALQ ;
|
|
S W1=0 U IO W @IOF F S W1=$O(^YSG("CEN",W1)) Q:'W1 I '$P(^(W1,0),U,13) S P1=0 D FS0^YSCEN S P1=1 D L1 Q:Q3
|
|
G END0
|