60 lines
3.0 KiB
Mathematica
60 lines
3.0 KiB
Mathematica
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
|