source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCHACT0.m@ 1154

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1FBCHACT0 ;AISC/DMK-NON-VA HOSPITAL ACTIVITY CONT ;01JUL01
2 ;;3.5;FEE BASIS;**28**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4ENT S (SCNT,MCNT,PCNT,SDED,MDED,PDED,ASCNT,AMCNT,APCNT,DSCNT,DMCNT,DPCNT,RSCNT,RMCNT,RPCNT,FBDAYS,FBMDAY,FBSDAY,FBPDAY)=0,FBBED=""
5 F J="AA","AD","AR" F I=0:0 S I=$O(^TMP("FBCH",$J,J,FBK,I)) Q:I'>0 I $D(^FBAAA("AG",I_";FB7078(")) D 161
6 D EN,WRT
7 K AMCNT,APCNT,ASCNT,DMCNT,DPCNT,DSCNT,FBADDT,FBCHDT,FBDA,FBDAYS,FBDED,FBFRDT,FBMDAY,FBPDAY,FBSDAY,FBTODT,FBTYPE,I,J,MCNT,PCNT,PDED,Q,QQ,RMCNT,RPCNT,RSCNT,SCNT,SDED,X,Y,MDED Q
8161 S FBDA(1)=$O(^FBAAA("AG",I_";FB7078(",0)),FBDA=$O(^FBAAA("AG",I_";FB7078(",FBDA(1),0)) Q:'$D(^FBAAA(FBDA(1),1,FBDA,0)) S FBADDT=$P(^(0),"^",18),FBFRDT=$P(^(0),"^"),FBTODT=$P(^(0),"^",2)
9 S FBFRDT=$S(FBCHDT>FBFRDT:FBCHDT,1:FBFRDT),FBTODT=$S(FBTODT="":FBENDDT,FBTODT>FBENDDT:FBENDDT,1:FBTODT)
10 I FBADDT="00" S SCNT=SCNT+1
11 I FBADDT=10 S MCNT=MCNT+1
12 I FBADDT=86 S PCNT=PCNT+1
13 I J="AA" S ASCNT=ASCNT+SCNT,AMCNT=AMCNT+MCNT,APCNT=APCNT+PCNT D RESET Q
14 I J="AD" S DSCNT=DSCNT+SCNT,DMCNT=DMCNT+MCNT,DPCNT=DPCNT+PCNT D RESET Q
15 I J="AR" S RSCNT=RSCNT+SCNT,RMCNT=RMCNT+MCNT,RPCNT=RPCNT+PCNT D RESET Q
16 Q
17WRT D HED
18 W !,"MEDICINE",!,"--------" D HED1
19 W ?3,AMCNT,?17,DMCNT-MDED,?32,MDED,?45,RMCNT,?59,FBMDAY,?73,^TMP("FB",$J,FBK,10),!
20 W !,"SURGERY",!,"-------" D HED1
21 W ?5,ASCNT,?20,DSCNT-SDED,?32,SDED,?45,RSCNT,?59,FBSDAY,?73,^TMP("FB",$J,FBK,"00"),!
22 W !,"PSYCHIATRY",!,"----------" D HED1
23 W ?5,APCNT,?20,DPCNT-PDED,?32,PDED,?45,RPCNT,?59,FBPDAY,?73,^TMP("FB",$J,FBK,86),!
24 Q
25HED S Q="=",$P(Q,"=",79)="=",Y=FBCHDT X ^DD("DD") S FBCHDT=Y
26 W !,?21,FBHED_" ACTIVITY REPORT",!,?21,"----------------------------------",!,?1,"For the month of: ",FBCHDT,!,Q,! Q
27RESET S (MCNT,SCNT,PCNT)=0 Q
28DAYS S FBDAYS=0,X1=FBTODT,X2=FBFRDT D D^%DTC S FBDAYS=$S(X<1:1,1:X+1)
29 Q
30HED1 W !?41,"PATIENTS",?57,"DAYS OF",?70,"DAYS OF",!?1,"ADMISSIONS",?15,"DISCHARGES",?30,"DEATHS",?40,"REMAINING",?58,"CARE",?69,"UNAUTH CARE",! F QQ=1:1:80 W "-"
31 W ! Q
32EN F I=FBCHDT:0 S I=$O(^FB7078("AD",FBTYPE,I)) Q:I'>0 F J=0:0 S J=$O(^FB7078("AD",FBTYPE,I,J)) Q:J'>0 D VENTYPE^FBCHACT I FBVENTP=FBK I $D(^FB7078(J,0)) S FBADMIT=$P(^(0),"^",4),FBTODT=I D GETBED,CHK
33 Q
34CHK Q:FBADMIT>FBENDDT S FBFRDT=$S(FBADMIT<FBCHDT:FBCHDT,1:FBADMIT)
35 S FBTODT=$S(FBTODT>FBENDDT:FBENDDT,1:FBTODT)
36 D DAYS I FBTODT'=FBENDDT S FBDAYS=FBDAYS-1
37 I FBBED="00" S FBSDAY=FBSDAY+FBDAYS I FBDED=2!(FBDED=3) S SDED=SDED+1 K FBDED
38 I FBBED=10 S FBMDAY=FBMDAY+FBDAYS I FBDED=2!(FBDED=3) S MDED=MDED+1 K FBDED
39 I FBBED=86 S FBPDAY=FBPDAY+FBDAYS I FBDED=2!(FBDED=3) S PDED=PDED+1 K FBDED
40 S FBBED="" Q
41GETBED S FB(1)=$O(^FBAAA("AG",J_";FB7078(",0)) Q:FB(1)="" S FB=$O(^FBAAA("AG",J_";FB7078(",FB(1),0)) Q:FB="" I $D(^FBAAA(FB(1),1,FB,0)) S FBBED=$P(^(0),"^",18),FBDED=$P(^(0),"^",15)
42 Q
Note: See TracBrowser for help on using the repository browser.