source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN34.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1YSCEN34 ;ALB/ASF-DRG WARD LOOKUP ;12/19/90 09:18 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3ENDRG ;
4 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
5 Q
6P1 ;
7 S YSFLGP=1,YSAF=2,YSBE=+$P(^YSG("CEN",W1,0),U,10),(Q3,P9)=0 K ^UTILITY($J,"YS")
8 D HD S YSNM="" F S YSNM=$O(^UTILITY($J,YSNM)) Q:YSNM="" K DRGCAL D P2 Q:Q3
9 D WAIT^YSCEN1 Q
10P2 ;
11 Q:Q3 S YSDFN=0 F S YSDFN=$O(^UTILITY($J,YSNM,YSDFN)) Q:'YSDFN S YDA=^(YSDFN) D P3
12 Q
13P3 ;
14 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
15 D ENPT^YSUTL I $Y+5>IOSL D WAIT^YSCEN1 Q:Q3 D HD
16 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
17 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
18 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:"")
19 Q
20HD ;
21 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)
22 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"
23 W ! F ZZ=1:1:11 W "======="
24 Q
25END ;
26 K ZTSK,X,DIC,DIK,YSOPT1,YSOPT1L,P9,YSBID D KVAR^VADPT W !! D KILL^%ZTLOAD,^%ZISC Q
27 Q
28L2A ; Called by routine YSCEN39
29 ;
30 I YSFLG Q:$P(VAIP(4),U)>3
31 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)
Note: See TracBrowser for help on using the repository browser.