source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN81.m@ 1801

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 YSTO<YSFR D
 .W !?5," ... Beginning date is after the Ending date ..."
 .W !?5,"... Please reenter both the Beginning and Ending Date ..."
 I YSTO<YSFR G GFR
 ;
OP ;
 R !!,"(T)otal, (F)emale, (G)eriatric, or (V)ietnam Era patients? T// ",C5:DTIME S YSTOUT='$T,YSUOUT=X["^" Q:YSTOUT!YSUOUT
 S C5=$TR($E(C5_"T"),"tfgv","TFGV")
 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
 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
ENQ ;
 K V S $P(V,"*",81)="" U IO D START G END
START ;
 S Q3=0,L="",L1="| ",$P(L2,"-",80)="" F ZZ=1:1:9 S L=L_"----|",L1=L1_"  "_ZZ_"0%"
 S L="Date   Pts    Occ. |"_L_"-----|"
 S YSND=C5'="T" ;If C5=T, YSND=0... node 0.   Otherwise, YSND=1.
 S YSND1=$S(C5="T":2,C5="F":1,C5="G":3,C5="V":4) ;Sets piece of node 1
 F YSM=YSFR:1:YSTO S:YSM?2N1"13" YSM=YSM+88 D 1,WAIT:M5 Q:Q3
 D MON Q
 ;
1 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
 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
 ;