YSCEN81 ;ALB/ASF-CENSUS DAYS ;4/3/90 11:49 ;;5.01;MENTAL HEALTH;**63**;Dec 30, 1994 ; ; Called from the top by MENU option YSCENREM ; A ; K P,Y D UN^YSCEN2 Q:+Y'>0 ; GFR ; W ! S (YSFR,YSTO)=0,%DT("A")="Enter the Beginning Month/Year: ",%DT="AEQ" D ^%DT Q:Y<1 I $E(Y,6,7)'?2"0" W !?5," ... Enter Month and Year only (Example: 'June 90') ..." G GFR S YSFR=$E(+Y,1,5) ; TO ; W ! S %DT("A")="Enter the Ending Month/Year: ",%DT="AEQ" D ^%DT Q:Y<1 I $E(Y,6,7)'?2"0" W !?5," ... Enter Month and Year only (Example: 'June 90') ..." G TO S YSTO=$E(+Y,1,5) ; I YSTO2 @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 Q:'M5 W !!,"Average Occupancy for the above ",M5," days = ",$J(M4/M5,4,1),"%" S P(YSM)=M4/M5 Q LST ; 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 W !,$E(YSD,4,5)_"/"_$E(YSD,6,7)," ",$J(C1,4)," ",$J(P,6,1),"% |",$E(V,1,P/2),?70,"|" I C2'=C3 S C3=C2 W ?$X+2,C2 S M4=M4+P Q HDR ; W @IOF,"Ward '",W2,"' ",$S(C5="T":"",C5="F":"Female ",C5="G":"Geriatric ",C5="V":"Vietnam Era ",1:"error"),"patients: " ;the correct month (YSM) is set & available at the top of every page. Ie., One month per page. S Y=YSM D DD^%DT W " ",Y D NOW^%DTC S Y=% D DD^%DT W ?(IOM-$L(Y)-1),Y W !,L2,!?19,L1,?70,"| beds",!,L QUIT ; WAIT ; W $C(7) D WAIT^YSCEN1 Q MON ; S L=" YR/MO Occ.|"_$P(L,"|",2,99),X=$O(P(0)) Q:'X!Q3 D HDR1,MONL,WAIT Q MONL ; 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 Q HDR1 ; W @IOF,"Ward '",W2,"' ",$S(C5="T":"Total",C5="F":"Female",C5="G":"Geriatric",C5="V":"Vietnam Era",1:"error") W " Monthly Averages " D TIME^YSCEN2 W !,L2,!?12,"Average",L1,?70,"|",!,L Q END ; D KILL^%ZTLOAD K %,%DT,%ZIS,C,C1,C2,C3,C5,I7,L,L1,L2,L3,M4,M5,P,POP,Q3,T,V,W1,W2 K Y,Y,YSD,YSFR,YSM,YSND,YSND1,YSTM,YSTMX,YSTO,YSTOT,YSTOUT K ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZZ D ^%ZISC QUIT ;