YSCEN34 ;ALB/ASF-DRG WARD LOOKUP ;12/19/90  09:18 ;
 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
ENDRG ;
 D A^YSCEN3 Q:Y<1!(POP)  W @IOF S YSDRGFL=0,YSN1="X",YSOPT2="P1^YSCEN34",(P,P1)=0 K ^UTILITY($J) D:T6'="A" L2^YSCEN2 D:T6="A" L1^YSCEN2 G END
 Q
P1 ;
 S YSFLGP=1,YSAF=2,YSBE=+$P(^YSG("CEN",W1,0),U,10),(Q3,P9)=0 K ^UTILITY($J,"YS")
 D HD S YSNM="" F  S YSNM=$O(^UTILITY($J,YSNM)) Q:YSNM=""  K DRGCAL D P2 Q:Q3
 D WAIT^YSCEN1 Q
P2 ;
 Q:Q3  S YSDFN=0 F  S YSDFN=$O(^UTILITY($J,YSNM,YSDFN)) Q:'YSDFN  S YDA=^(YSDFN) D P3
 Q
P3 ;
 S L=^YSG("INP",YDA,0),J1=$P(^YSG("INP",YDA,7),U,3),PTF=0,DFN=YSDFN,X2=$P(L,U,3),X1=DT,X3="current" Q:DFN<1
 D ENPT^YSUTL I $Y+5>IOSL D WAIT^YSCEN1 Q:Q3  D HD
 W !,$E(YSNM,1,25),?27,YSBID,?33,$$FMTE^XLFDT(X2,"5ZD"),?46,X3 D ^%DTC S LOS=$S(X>0:X,X=0:1,1:"") W ?56,LOS
 S YSDRGFL=1,(YSDRG,DXLS)=0 D ^YSCEN32 Q:'$D(DRGCAL)  S YSDRG=$E($P(DRGCAL,U),4,6),YSWT=$P(DRGCAL,U,YSAF) W ?61,$S(DXLS:$P(^ICD9(DXLS,0),U),1:""),?70,YSDRG,L7 Q:'YSBE
 S YSBD=YSWT*$P(^YSA(602,1,0),U,5)/YSBE W ?75,$J(YSBD-LOS,3,0) S X=LOS/YSBD*100 W " ",$S(X>149.99:"#",X>99.99:"*",X>74.99:"@",1:"")
 Q
HD ;
 S P9=P9+1 W !,@IOF,"DRG Lookup" K Y D ENDTM^YSUTL W ?50,YSDT(1)," ",YSTM,"  pg. ",P9,!,"Ward: ",$P(^DIC(42,W1,0),U),"  Team: ",$P(^YSG("SUB",T6,0),U)
 W:YSFLGP !?75,"days to",!?33,"ward",?46,"ward",?56,"ward",?75,"break",!?27,"ssn",?33,"admit",?46,"discharge",?56,"LOS",?61,"DXLS",?70,"DRG",?75,"even"
 W ! F ZZ=1:1:11 W "======="
 Q
END ;
 K ZTSK,X,DIC,DIK,YSOPT1,YSOPT1L,P9,YSBID D KVAR^VADPT W !! D KILL^%ZTLOAD,^%ZISC Q
 Q
L2A ;  Called by routine YSCEN39
 ;
 I YSFLG Q:$P(VAIP(4),U)>3
 S YSC=YSC+1 W !,$E(VADM(1),1,20),?22,$P($P(VAIP(3),U,2),"@"),?34,$E($P(VAIP(4),U,2),1,18),?64,$E($P(VAIP(5),U,2),1,14)