source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN6.m@ 1474

Last change on this file since 1474 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1YSCEN6 ;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
8ENQ ;
9 U IO W @IOF,!?15,"RECENT ADMITS",?30,"printed " K Y D ENDTM^YSUTL W YSDT(1)," ",YSTM
10IN ;
11 S P1=0 K YSOPT1 D FS^YSCEN,L1^YSCEN2 K ^UTILITY($J)
12WLP ;
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
16SL ;
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
20LST ;
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
24ADMIT ;
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
31T ;
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
35DX ; Called from routine YSCEN61
36 D PDX I YSPDX W ?45,$E(YSPDX(1),1,19),?70,$$FMTE^XLFDT(YSPDX(2),"5ZD")
37 Q
38END0 ;
39 D KILL^%ZTLOAD
40 K YSPST,DA,YSDA2,YSF
41END ;
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 ;
44PDX ; Called from routines YSCEN23, YSCEN32, YSCEN35
45 D PDX^YSDX0002
46 QUIT
47 ;
48ENHM ;
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
52PAST ;
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
56SCR ;
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
Note: See TracBrowser for help on using the repository browser.