source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1YSCEN ;ALB/ASF-MENTAL HEALTH CENSUS FACE SHEET ;12/3/91 16:38 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
41 ;
5 S P1=1 W @IOF,?10,"M E N T A L H E A L T H C E N S U S"
6 K Y D ENDTM^YSUTL W ?55,YSDT(1)," ",YSTM D PRH
7FS ; Called from routine YSCEN6
8 ;
9 S (YSTOP,YSSCT,Q3,T,S1,YSSC1,YSOP1)=0 S:'$D(P1) P1=0
10 S J=0 F S J=$O(^YSG("CEN","AFS",J)) Q:'J S W2=$O(^YSG("CEN","AFS",J,0)),W1=W2 D:$Y+5>IOSL WW:P1 Q:Q3 D FS0
11 Q:Q3 I P1 W !!?13,"Total:",?23,$J(YSTOP,4),?33,$J(T,4),?45,$J(YSTOP-T,4),?54,$J(YSSCT,4) I YSTOP W ?67,$J(T/YSTOP*100,4,1),"%"
12 I P1,IOST?1"C-".E D WAIT^YSCEN1
13 Q
14FS0 ; Called from routines YSCEN1, YSCEN13, YSCEN2, YSCEN21, YSCEN22
15 ; YSCEN23, YSCEN24, YSCEN3, YSCEN4, YSCEN51, YSCEN55, YSCEN61, YSCEN8
16 ;
17 S W2=$P(^DIC(42,+^YSG("CEN",W1,0),0),U) D FS1 I P1,$$ACTIVE(+W1) D PR,PRS:$P(^YSG("CEN",W1,0),U,4) S:$P(^(0),U,5) (YSOP1,YSSC1,S1)=0 W:$P(^(0),U,7) !
18 Q
19FS1 ;
20 N J S YSDFN=0,R=0 F S YSDFN=$O(^DPT("CN",W2,YSDFN)) Q:YSDFN'>0 S YSDA=$O(^YSG("INP","CP",+YSDFN,0)) I +$G(^YSG("INP",+YSDA,7))=W1 S:P1 R=R+1,S1=S1+1,T=T+1
21 Q:'P1 S YSSC=0 I $D(^DGS(41.1,"ARSV",W1)) S X=0 F S X=$O(^DGS(41.1,"ARSV",W1,X)) Q:'X I $D(^DGS(41.1,X,0)),$P(^(0),U,2)'<DT S YSSC=YSSC+1
22 K YSBED S DIC="^DIC(42,",DA=W1,DR=".23",DIQ(0)="E",DIQ="YSBED(" D EN^DIQ1 K DIC,DR,DIQ,DA
23 S YSOP=YSBED(42,W1,.23,"E"),YSTOP=YSTOP+YSOP,YSSCT=YSSCT+YSSC,YSSC1=YSSC1+YSSC,YSOP1=YSOP1+YSOP
24 Q
25PR ;
26 W !,$P(^YSG("CEN",W1,0),U,2),?24,$J(YSOP,3),?34,$J(R,3),?46,$J(YSOP-R,3),?55,$J(+YSSC,3),?67 W:YSOP'=0&(YSOP]"") $J(R/YSOP*100,4,1),"%" W:YSOP=0!(YSOP="") "***" Q
27PRS ;
28 S X=$S($P(^YSG("CEN",W1,0),U,6)?1A.E:$P(^(0),U,6),1:"sub-total:") W !?9,X,?24,$J(YSOP1,3),?34,$J(S1,3),?46,$J(YSOP1-S1,3),?55,$J(YSSC1,3)
29 W ?67,$S(YSOP:$J(S1/YSOP1*100,4,1)_"%",1:"***") Q
30PRH ;
31 W !,"Ward",?22,"operating",?34,"current",?46,"empty",?55,"sched",?65,"occupancy",!?24,"beds",?34,"patients",?46,"beds",?55,"admis",?67,"rate",! F ZZ=1:1:11 W "-------"
32 Q
33WW ;
34 D WAIT^YSCEN1 Q:Q3 W @IOF D PRH Q
35 Q
36 ;
37ACTIVE(X) ;Is ward active? 0=No, 1=Yes
38 S X=$G(^YSG("CEN",+$G(X),0))
39 QUIT '(+$P(X,U,13))
40 ;
41EN ; Called from MENU option YSCENFS
42 ;
43 K IOP S %ZIS="Q" D ^%ZIS G:POP END
44 I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^YSCEN",ZTIO=IO,ZTDESC="Mental Health Inpatient",ZTSAVE("P")="" D ^%ZTLOAD G END
45ENQ ;
46 U IO D 1 G:Q3 END0 D ENALL^YSCEN21
47END0 ;
48 D KILL^%ZTLOAD
49END ;
50 K ZTDESC,ZTSK,ZTIO,B,A1,C1,D1,D2,P1,YSW1,YSDFN,W1,I7,J,R,T,YSLST,YSSCT,W2,T6,YSSC,YSSC1,YSOP,YSOP1,YSTOP,I,X,Y,DIC,DIK,DIE,G2,J3,K2,X1,S1,Q3,J1,L,L7,LOS,PTF,W1,YSAGE,YSBD,YSBE,SEX,DXLS,ZZ
51 K YSDRG,YSDRGFL,YSDY,YSFLGP,YSFR,YSN,YSN1,YSNM,YSPDX,YSPDX,YSR,YSSEX,YSSSN,YST1,YSWT,YSX,ZTRTN,ZTSAVE,YSOR,YSBID,VA,PTI D KVAR^VADPT W !! D ^%ZISC Q
52 ;
53KILLALL ;This sub-routine is an exit action called by YSCEN* options
54 K DZ,G7,VAIN,VAINDT,VAIP,X5,XQH
55 K YS,YSA8,YSAC,YSADR,YSAF,YSAGE,YALL,YSAOR,YSB,YSBAR,YSBD,YSBE,YSBED
56 K YSBID,YSBLN,YSC,YSC1,YSCD,YSCEN3F,YSCENDA,YSCENDNO,YSCENDO
57 K YSCENDTA,YSCENI,YSCENLP,YSCENN,YSCENOK,YSCENPB,YSCENRNO,YSCENRT
58 K YSCENWNO,YSCENX,YSCF,YSCHAR,YSCNT,YSCON,YSCOP,YSCOPY,YSCR,YSCRX
59 K YSCTN,YSD,YSDA,YSDA2,YSDAT,YSDATE,YSDAY,YSDFN,YSDFN1,YSDFN9,YSDIN
60 K YSDISP,YSDOB,YSDOT,YSDPT,YSDR,YSDRG,YSDRGFL,YSDRT,YSDRUG,YSDRUG2
61 K YSDT,YSDTM,YSDUZ,YSDX,YSDY,YSEN,YSEND,YSENT,YSET,YSF,YSF4,YSFA
62 K YSFDAT,YSFFS,YSFHDR,YSFIN,YSFIRST,YSFL5,YSFL6,YSFL7,YSFLG,YSFLGP
63 K YSFR,YSFRM,YSFRM1,YSFRT,YSFS,YSG,YSGL1,YSGP,YSH1,YSHDR,YSHM,YSHR
64 K YSHTM,YSI,YSIDT,YSIG,YSIGI,YSINDT,YSJ,YSKK,YSLDRUG,YSLDT,YSLDT1
65 K YSLDTY,YSLFT,YSLIG,YSLL,YSLST,YSM,YSMN,YSMOR,YSN,YSN1,YSND,YSND1
66 K YSNM,YSNN,YSNOFORM,YSNOW,YSNT,YSNX,YSO,YSOP,YSOP1,YSOPT1,YSOPT1L
67 K YSOPT2,YSOPT9L,YSOR,YSPO,YSPCK,YSPDX,YSPE,YSPF,YSPHY,YSPNH,YSPOIN
68 K YSPPL,YSPRG,YSPRG3,YSPST,YSPSV,YSPY,YSPYSTO,YSPZ,YSQT,YSQTY
69 K YSR,YSR1,YSR11,YSR2,YSR3,YSR4,YSR5,YSR99,YSRD,YSREM,YSRX1,YSRXGL
70 K YSRXGL2,YSRXNO,YSSC,YSSC1,YSSCT,YSSEX,YSSL,YSSSN,YSSX,YST,YST0,YST1
71 K YSTB,YSTBO,YSTLE,YSTLL,YSTLST,YSTLT,YSTM,YSTM7,YSTM8,YSTMX,YSTO,YSTO1
72 K YSTOP,YSTOT,YSTOUT,YSTP,YSTP1,YSTS,YSTS1,YSTST,YSTY,YSU,YSUN,YSUOUT
73 K YSUS,YSUSER,YSUSN,YSV,YSW1,YSWDAT,YSWHO,YSWT,YSX,YSYD,YSYDT,YY
74 K Z,Z1,Z4,ZZ
Note: See TracBrowser for help on using the repository browser.