source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN61.m@ 1754

YSCEN61 ;ALB/ASF,SLC/BB-MH WARD LOS ;4/16/92  10:40 ;
 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
 ;
 ; Called from the top by MENU option YSCENLOS
 ;
ALOS ;
 K L,H,YSOPT1,YSOPT2 S IOP=0 D ^%ZIS K IOP W @IOF,!?IOM-$L("LENGTH OF WARD STAY FOR CURRENT INPATIENTS")\2,"LENGTH OF WARD STAY FOR CURRENT INPATIENTS"
R ;
 R !!,"(A)verage MH ward LOS, (S)ort by MH ward LOS, (B)reak even report? A// ",A7:DTIME S YSTOUT='$T,YSUOUT=A7["^" I YSTOUT!YSUOUT G END
 S:A7="" A7="A" S A7=$TR($E(A7),"asb","ASB") G ST:A7="A",C1:A7="B",CT:A7="S"
 W !!,"Enter 'A' for averages by ward/team",!,"Enter 'S' to show patients based on MH ward LOS",!,"Enter 'B' for extensive report of DRG, DDXLS and LOS" G R
CT ;
 R !!,"Display Patients with MH WARD LOS greater than how many days? 30// ",H:DTIME S YSTOUT='$T,YSUOUT=H["^" G:YSTOUT END
 S YSR1="H",YSR2=30,YSR3=999 D ^YSCEN14 G END:H=-1,CT:H="?"
XXX R !!,"All Wards? Y// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" G:YSTOUT END
 S YSR1="X",YSR2="Y",YSR3="YN",YSR4="Enter No to list only one ward." D ^YSCEN14 G END:X=-1,XXX:X="?",ST:X="Y"
 D UN^YSCEN2 G:Y<1 END K IOP S %ZIS="Q" D ^%ZIS G:POP END
 I $D(IO("Q")) K IO("Q") S ZTRTN="ENQO^YSCEN61",ZTDESC="YS IP 61",(ZTSAVE("W1"),ZTSAVE("W2"),ZTSAVE("A7"),ZTSAVE("H"))="" D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
ENQO ;
 U IO D HD,IN,CAL,@($S($D(H):"LP",1:"PRT")) G END0
ST ;
 K IOP S %ZIS="Q" D ^%ZIS G:POP END
 I $D(IO("Q")) K IO("Q") S ZTRTN="ENQST^YSCEN61",ZTDESC="YS IP 61",(ZTSAVE("W1"),ZTSAVE("W2"),ZTSAVE("A7"),ZTSAVE("H"))="" D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
ENQST ;
 U IO D HD S YSFS=0 F  S YSFS=$O(^YSG("CEN","AFS",YSFS)) Q:'YSFS  S W1=$O(^YSG("CEN","AFS",YSFS,0)) D IN,CAL,@($S($D(H):"LP",1:"PRT")) W ! K L I $Y+5>IOSL D WAIT^YSCEN1 G:Q3 END D HD
 G END0
CAL ;
 S (T6,N)=0 F  S T6=$O(^YSG("INP","AWC",W1,T6)) Q:'T6  S YSN=0 F  S YSN=$O(^YSG("INP","AWC",W1,T6,YSN)) Q:'YSN  S G=^YSG("INP",YSN,0) D CAL1
 Q
CAL1 ;
 S YSDFN=$P(G,U,2),X1=DT,X2=$P(G,U,3),YSUN=$P(G,U,4) S:YSUN="" YSUN="UN" D ^%DTC S:'$D(L(W1)) L(W1)=0 S N=N+1 S:X=0 X=1
 S:'$D(L(W1,YSUN)) L(W1,YSUN)=0,N(W1,YSUN)=0 S N(W1,YSUN)=N(W1,YSUN)+1,L(W1)=(L(W1)+X)_U_N,L(W1,YSUN)=L(W1,YSUN)+X_U_N(W1,YSUN)
 I $D(H),X>H S ^UTILITY($J,9999999-X,YSDFN)=G
 Q
PRT ;
 W !,$P(^YSG("CEN",W1,0),U,2) I '$D(L(W1)) W ?25,"***** NO PATIENTS ****" Q
 W ?25,"Total days: ",+L(W1),?45,"Patients: ",$P(L(W1),U,2),?60,"Average: ",$J(+L(W1)/$P(L(W1),U,2),6,2),!
 S U1="" F  S U1=$O(L(W1,U1)) Q:U1=""  D PRT2
 Q
PRT2 ;
 S U3=$S(U1="UN":"UNASSIGNED",1:$P(^YSG("SUB",U1,0),U)) W !?3,U3,?25,"Total days: ",+L(W1,U1),?45,"Patients: ",$P(L(W1,U1),U,2),?60,"Average: ",$J(+L(W1,U1)/$P(L(W1,U1),U,2),6,2)
 Q
LP ;
 W !?10,"Ward: ",W2 I '$D(^UTILITY($J)) W !,"*** NO PATIENTS " W:H>0 " WITH AN MH WARD LOS GREATER THAN  ",H," DAYS ***" Q
 W "  patients" W:H>0 " with MH WARD LOS>",H W !,"Name",?17,"age  entry",?32,"days",?51,"primary dx",?73,"on" S C3=0 F  S C3=$O(^UTILITY($J,C3)) Q:'C3  D LP1
 Q
LP1 ;
 S YSDFN=0 F  S YSDFN=$O(^UTILITY($J,C3,YSDFN)) Q:'YSDFN  S G=^(YSDFN) D ENPT^YSUTL W !,$E(YSNM,1,16),?17,YSAGE D D W ?21,D,?31,$J(9999999-C3,4),?37 S X=$P(G,U,5) D:X?1N.N D3^YSCEN2 W ?49 D DX^YSCEN6
 Q
END0 ;
 D KILL^%ZTLOAD,WAIT^YSCEN1
END ;
 K ZTSK,%Y,C1,Q3,T6,YSDTM,D,YSDX,F,YSFS,G,R,T2,U1,U3,YSUN,YSDOB,YSSEX,YSSSN,X1,X2,YSAGE,YSNM,YSPDX,YSTM,H,P1,W2,W1,L,N,^UTILITY($J),YSDFN,YSBID,X,Y,A7,I,J,C3 D KVAR^VADPT W !! D ^%ZISC Q
HD ;
 W @IOF,!?10,"LENGTH OF WARD STAY FOR CURRENT INPATIENTS"
 K Y D ENDTM^YSUTL W ?55,YSDT(1)," ",YSTM,! I $D(H),H=0 W ?10,"*** SORTED BY MH WARD LOS ***",! Q
 Q
D ;
 S D=$P(G,U,3),D=$$FMTE^XLFDT(D,"5ZD") Q
C1 ;
 S YSX="C" D EXP0^YSCEN53,EN^YSCEN52
C11 ;  Called by routine YSCEN52
 K A7,AGE,B,C,DAM,DFN,DIYS,DRG,DRGCAL,DXLS,EXP,J1,L,L1,L5,L6,L7,L8,LOS,MDC,NDR,NO,NOR,NSD,OR,PD,PTF,RG,SD,SD1,SEX,T6,TAC,TRS,X3,YS,YSAF,YSBAR,YSBD,YSBE,YSDRG,YSDRGFL,YSDTM,YSDY,YSFLGP,YSFR,YSN,YSN1
 K YSR,YSSX,YST1,YSTM,YSWT,YSX,W1,W2,YSTO,ZTSK,I Q
IN ;
 S P1=0 K YSOPT1 D FS0^YSCEN,L1^YSCEN2 K ^UTILITY($J)