source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN81.m@ 789

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1YSCEN81 ;ALB/ASF-CENSUS DAYS ;4/3/90 11:49
2 ;;5.01;MENTAL HEALTH;**63**;Dec 30, 1994
3 ;
4 ; Called from the top by MENU option YSCENREM
5 ;
6A ;
7 K P,Y D UN^YSCEN2 Q:+Y'>0
8 ;
9GFR ;
10 W ! S (YSFR,YSTO)=0,%DT("A")="Enter the Beginning Month/Year: ",%DT="AEQ" D ^%DT
11 Q:Y<1
12 I $E(Y,6,7)'?2"0" W !?5," ... Enter Month and Year only (Example: 'June 90') ..." G GFR
13 S YSFR=$E(+Y,1,5)
14 ;
15TO ;
16 W ! S %DT("A")="Enter the Ending Month/Year: ",%DT="AEQ" D ^%DT
17 Q:Y<1
18 I $E(Y,6,7)'?2"0" W !?5," ... Enter Month and Year only (Example: 'June 90') ..." G TO
19 S YSTO=$E(+Y,1,5)
20 ;
21 I YSTO<YSFR D
22 .W !?5," ... Beginning date is after the Ending date ..."
23 .W !?5,"... Please reenter both the Beginning and Ending Date ..."
24 I YSTO<YSFR G GFR
25 ;
26OP ;
27 R !!,"(T)otal, (F)emale, (G)eriatric, or (V)ietnam Era patients? T// ",C5:DTIME S YSTOUT='$T,YSUOUT=X["^" Q:YSTOUT!YSUOUT
28 S C5=$TR($E(C5_"T"),"tfgv","TFGV")
29 I "TFGV"'[C5 W !!,"Enter 'T' for all patients remaining",!?6,"'F' for female patients only remaining",!?6,"'G' for patients over age 65 remaining",!?6,"'V' for Vietnam era patients remaining",! G OP
30 K IOP S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^YSCEN81",ZTDESC="YS IP 81",(ZTSAVE("W1"),ZTSAVE("C5"),ZTSAVE("W2"),ZTSAVE("YSTO"),ZTSAVE("YSFR"))="" D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) Q
31ENQ ;
32 K V S $P(V,"*",81)="" U IO D START G END
33START ;
34 S Q3=0,L="",L1="| ",$P(L2,"-",80)="" F ZZ=1:1:9 S L=L_"----|",L1=L1_" "_ZZ_"0%"
35 S L="Date Pts Occ. |"_L_"-----|"
36 S YSND=C5'="T" ;If C5=T, YSND=0... node 0. Otherwise, YSND=1.
37 S YSND1=$S(C5="T":2,C5="F":1,C5="G":3,C5="V":4) ;Sets piece of node 1
38 F YSM=YSFR:1:YSTO S:YSM?2N1"13" YSM=YSM+88 D 1,WAIT:M5 Q:Q3
39 D MON Q
40 ;
411 W:$Y>2 @IOF S (M4,M5,C3)=0 F I7=1:1:31 S YSD=YSM_"00"+I7 D:$D(^DG(41.9,W1,"C",YSD,1))#2 HDR:$Y<2,LST I $Y+4>IOSL D WAIT Q:Q3 D HDR
42 Q:'M5 W !!,"Average Occupancy for the above ",M5," days = ",$J(M4/M5,4,1),"%" S P(YSM)=M4/M5 Q
43LST ;
44 S M5=M5+1,C1=$P(^DG(41.9,W1,"C",YSD,YSND),U,YSND1),C2=$P(^DG(41.9,W1,"C",YSD,1),U,2) W:C2=""!(C2<1) !?5,"There are NO patients remaining on this ward at the end of the census day.",! Q:C2=""!(C2<1) S P=C1/C2*100
45 W !,$E(YSD,4,5)_"/"_$E(YSD,6,7)," ",$J(C1,4)," ",$J(P,6,1),"% |",$E(V,1,P/2),?70,"|"
46 I C2'=C3 S C3=C2 W ?$X+2,C2
47 S M4=M4+P Q
48HDR ;
49 W @IOF,"Ward '",W2,"' ",$S(C5="T":"",C5="F":"Female ",C5="G":"Geriatric ",C5="V":"Vietnam Era ",1:"error"),"patients: "
50 ;the correct month (YSM) is set & available at the top of every page. Ie., One month per page.
51 S Y=YSM D DD^%DT W " ",Y
52 D NOW^%DTC S Y=% D DD^%DT W ?(IOM-$L(Y)-1),Y
53 W !,L2,!?19,L1,?70,"| beds",!,L
54 QUIT
55 ;
56WAIT ;
57 W $C(7) D WAIT^YSCEN1 Q
58MON ;
59 S L=" YR/MO Occ.|"_$P(L,"|",2,99),X=$O(P(0)) Q:'X!Q3 D HDR1,MONL,WAIT
60 Q
61MONL ;
62 S T=0 F S T=$O(P(T)) Q:'T W !?4,$E(T,2,3)_"/"_$E(T,4,5)," ",$J(P(T),4,1),"% |",$E(V,1,P(T)/2),?70,"|" I $Y+4>IOSL D WAIT Q:Q3 D HDR1
63 Q
64HDR1 ;
65 W @IOF,"Ward '",W2,"' ",$S(C5="T":"Total",C5="F":"Female",C5="G":"Geriatric",C5="V":"Vietnam Era",1:"error")
66 W " Monthly Averages " D TIME^YSCEN2 W !,L2,!?12,"Average",L1,?70,"|",!,L Q
67END ;
68 D KILL^%ZTLOAD
69 K %,%DT,%ZIS,C,C1,C2,C3,C5,I7,L,L1,L2,L3,M4,M5,P,POP,Q3,T,V,W1,W2
70 K Y,Y,YSD,YSFR,YSM,YSND,YSND1,YSTM,YSTMX,YSTO,YSTOT,YSTOUT
71 K ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZZ
72 D ^%ZISC
73 QUIT
74 ;
Note: See TracBrowser for help on using the repository browser.