YSCEN6 ;ALB/ASF,SLC/BB-RECENT ADMITS ;12/19/90  09:25 ;11/18/93 15:35
 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
 ;
 ; Called from the top by MENU option YSCENNEW
 ;
 K ^UTILITY($J) S YSDX=DT,%DT="EQP",%DT(0)="-NOW" R !,"List admissions from what date: Today//",X:DTIME S YSTOUT='$T,YSUOUT=X["^" G END:YSTOUT!YSUOUT I X]"" D ^%DT K %DT S YSDX=Y G YSCEN6:Y<1
 S Y=YSDX D DD^%DT S T2=Y K IOP S %ZIS="Q" D ^%ZIS G:POP END I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^YSCEN6",ZTDESC="YS IP 6",(ZTSAVE("T2"),ZTSAVE("YSDX"))="" D ^%ZTLOAD W !,$S($D(ZTQUEUED):"QUEUED",1:"Not queued"),$C(7) G END
ENQ ;
 U IO W @IOF,!?15,"RECENT ADMITS",?30,"printed  " K Y D ENDTM^YSUTL W YSDT(1)," ",YSTM
IN ;
 S P1=0 K YSOPT1 D FS^YSCEN,L1^YSCEN2 K ^UTILITY($J)
WLP ;
 K ^UTILITY("YSCEN",$J) S YSDIN=0
 F  S YSDIN=$O(^YSG("INP","AIN",YSDIN)) Q:'YSDIN!(YSDIN>(9999999-YSDX))  S DA=0 F  S DA=$O(^YSG("INP","AIN",YSDIN,DA)) Q:'DA  S W1=+^YSG("INP",DA,7),^UTILITY("YSCEN",$J,W1,9999999-YSDIN,DA)=""
 I '$D(^UTILITY("YSCEN")) W !!!,"No patients admited since ",$C(7) S Y=YSDX D DD^%DT W Y D WAIT^YSCEN1 G END0
SL ;
 S (YSF,Q3)=0 F  S YSF=$O(^YSG("CEN","AFS",YSF)) Q:'YSF!(Q3)  S W1=$O(^(YSF,0)) D LST
 I $E($G(IOST),1,2)["C-" D SCR
 G END0
LST ;
 D T Q:Q3  I '$D(^UTILITY("YSCEN",$J,W1)) W !?10,"** none **",! Q
 S D=0!(Q3) F  S D=$O(^UTILITY("YSCEN",$J,W1,D)) Q:'D  S DA=0 F  S DA=$O(^UTILITY("YSCEN",$J,W1,D,DA)) Q:'DA  D ADMIT
 Q
ADMIT ;
 D T:($Y+5>IOSL) Q:Q3  S YSDFN=$P(^YSG("INP",DA,0),U,2),YSDTM=D
 W !,$$FMTE^XLFDT(D,"5ZD") D ENHM W:YSTM'?1":".E ?6,YSTM W ?15,$E($P(^DPT(YSDFN,0),U,9),6,9)
 W ?20,$P(^DPT(YSDFN,0),U) D DX S YSCD=YSDTM
 I $P(^YSG("INP",DA,7),U,2) S Y=$P(^YSG("INP",DA,7),U,2) D DD^%DT W !?3,"Left ward on: ",Y Q
 I $O(^YSG("INP","C",YSDFN,0))'=DA D PAST
 Q
T ;
 I $Y+5>IOSL D WAIT^YSCEN1 Q:Q3  W @IOF
 W !!,"Patients admitted to ",$P(^YSG("CEN",W1,0),U,2),"  ",T2,$S(YSDX=DT:"",1:"-Today"),!?2,"entry date",?15,"SSN",?45,"primary dx",?72,"on" Q
 Q
DX ;  Called from routine YSCEN61
 D PDX I YSPDX W ?45,$E(YSPDX(1),1,19),?70,$$FMTE^XLFDT(YSPDX(2),"5ZD")
 Q
END0 ;
 D KILL^%ZTLOAD
 K YSPST,DA,YSDA2,YSF
END ;
 K %DT,A,C1,D,M,N1,Q3,S1,S2,S3,T6,YSCD,YSDIN,YSDTM,YSHM,YSHR,YSMN,ZTQUEUED,YSDX,F,YSFS,G,R,T2,U1,U3,YSUN,X1,X2,YSAGE,YSNM,YSPDX,YSTM,H,P1,W2,W1,L,N,^UTILITY($J),YSDFN,X,Y,A7,I,J,C3 W !! D ^%ZISC Q
 ;
PDX ;  Called from routines YSCEN23, YSCEN32, YSCEN35
 D PDX^YSDX0002
 QUIT
 ;
ENHM ;
 K YSHM,YSTM S YSHM=$P(YSDTM,".",2),YSMN=$E(YSHM,3,4)_"00",YSMN=$E(YSMN,1,2)
 S YSHR=$E(YSHM,1,2),A=$S(YSHR<12:YSHR,YSHR>12:YSHR-12,YSHR=12:12,1:"00"),M=$S(YSHR<12:"A",YSHR=12&(YSMN>0):"P",YSHR>12:"P",1:0) S:A?1"0".N A=" "_$E(A,2) S:$L(A)=1 A=" "_A S YSTM=A_":"_YSMN_M
 Q
PAST ;
 S (YSDA2,YSPST)=0 F  S YSPST=$O(^YSG("INP","C",YSDFN,YSPST)) Q:'YSPST  S:YSPST'=DA YSDA2=YSPST
 I YSDA2 W !?3,"last psych ward ",$P(^DIC(42,+^YSG("INP",YSDA2,7),0),U)," : " S Y=$P(^YSG("INP",YSDA2,0),U,3)\1 D DD^%DT W Y," to " S Y=$P(^YSG("INP",YSDA2,7),U,2)\1 D DD^%DT W Y Q
 Q
SCR ;
 F I0=1:1:(IOSL-$Y-2) W !
 N DTOUT,DUOUT,DIRUT
 S DIR(0)="E" D ^DIR K DIR W @IOF Q