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