| 1 | YSCEN6 ;ALB/ASF,SLC/BB-RECENT ADMITS ;12/19/90 09:25 ;11/18/93 15:35
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; Called from the top by MENU option YSCENNEW
|
|---|
| 5 | ;
|
|---|
| 6 | 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
|
|---|
| 7 | 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
|
|---|
| 8 | ENQ ;
|
|---|
| 9 | U IO W @IOF,!?15,"RECENT ADMITS",?30,"printed " K Y D ENDTM^YSUTL W YSDT(1)," ",YSTM
|
|---|
| 10 | IN ;
|
|---|
| 11 | S P1=0 K YSOPT1 D FS^YSCEN,L1^YSCEN2 K ^UTILITY($J)
|
|---|
| 12 | WLP ;
|
|---|
| 13 | K ^UTILITY("YSCEN",$J) S YSDIN=0
|
|---|
| 14 | 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)=""
|
|---|
| 15 | I '$D(^UTILITY("YSCEN")) W !!!,"No patients admited since ",$C(7) S Y=YSDX D DD^%DT W Y D WAIT^YSCEN1 G END0
|
|---|
| 16 | SL ;
|
|---|
| 17 | S (YSF,Q3)=0 F S YSF=$O(^YSG("CEN","AFS",YSF)) Q:'YSF!(Q3) S W1=$O(^(YSF,0)) D LST
|
|---|
| 18 | I $E($G(IOST),1,2)["C-" D SCR
|
|---|
| 19 | G END0
|
|---|
| 20 | LST ;
|
|---|
| 21 | D T Q:Q3 I '$D(^UTILITY("YSCEN",$J,W1)) W !?10,"** none **",! Q
|
|---|
| 22 | 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
|
|---|
| 23 | Q
|
|---|
| 24 | ADMIT ;
|
|---|
| 25 | D T:($Y+5>IOSL) Q:Q3 S YSDFN=$P(^YSG("INP",DA,0),U,2),YSDTM=D
|
|---|
| 26 | W !,$$FMTE^XLFDT(D,"5ZD") D ENHM W:YSTM'?1":".E ?6,YSTM W ?15,$E($P(^DPT(YSDFN,0),U,9),6,9)
|
|---|
| 27 | W ?20,$P(^DPT(YSDFN,0),U) D DX S YSCD=YSDTM
|
|---|
| 28 | 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
|
|---|
| 29 | I $O(^YSG("INP","C",YSDFN,0))'=DA D PAST
|
|---|
| 30 | Q
|
|---|
| 31 | T ;
|
|---|
| 32 | I $Y+5>IOSL D WAIT^YSCEN1 Q:Q3 W @IOF
|
|---|
| 33 | 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
|
|---|
| 34 | Q
|
|---|
| 35 | DX ; Called from routine YSCEN61
|
|---|
| 36 | D PDX I YSPDX W ?45,$E(YSPDX(1),1,19),?70,$$FMTE^XLFDT(YSPDX(2),"5ZD")
|
|---|
| 37 | Q
|
|---|
| 38 | END0 ;
|
|---|
| 39 | D KILL^%ZTLOAD
|
|---|
| 40 | K YSPST,DA,YSDA2,YSF
|
|---|
| 41 | END ;
|
|---|
| 42 | 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
|
|---|
| 43 | ;
|
|---|
| 44 | PDX ; Called from routines YSCEN23, YSCEN32, YSCEN35
|
|---|
| 45 | D PDX^YSDX0002
|
|---|
| 46 | QUIT
|
|---|
| 47 | ;
|
|---|
| 48 | ENHM ;
|
|---|
| 49 | K YSHM,YSTM S YSHM=$P(YSDTM,".",2),YSMN=$E(YSHM,3,4)_"00",YSMN=$E(YSMN,1,2)
|
|---|
| 50 | 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
|
|---|
| 51 | Q
|
|---|
| 52 | PAST ;
|
|---|
| 53 | S (YSDA2,YSPST)=0 F S YSPST=$O(^YSG("INP","C",YSDFN,YSPST)) Q:'YSPST S:YSPST'=DA YSDA2=YSPST
|
|---|
| 54 | 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
|
|---|
| 55 | Q
|
|---|
| 56 | SCR ;
|
|---|
| 57 | F I0=1:1:(IOSL-$Y-2) W !
|
|---|
| 58 | N DTOUT,DUOUT,DIRUT
|
|---|
| 59 | S DIR(0)="E" D ^DIR K DIR W @IOF Q
|
|---|
