source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCHACT.m@ 1556

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1FBCHACT ;AISC/DMK-CALCULATES NON-VA HOSP ACTIVITY ;01JUL01
2 ;;3.5;FEE BASIS;**25,28**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 S Q="",$P(Q,"-",80)="-"
5 W !!?18,"NON-VA HOSPITAL ACTIVITY REPORTS",!?17,$E(Q,1,34),!
6 S DIR(0)="S^1:PUBLIC HOSPITAL;2:PRIVATE HOSPITAL;3:FEDERAL HOSPITAL" D ^DIR K DIR G END:$D(DUOUT),H^XUS:$D(DTOUT) S FBK=+Y
7 S FBK=$S(FBK=1:1,FBK=2:9,FBK=3:10,1:"")
8 G END:FBK="" S FBHED=Y(0)
9EN W !!,?5,"This option will calculate the ",FBHED," Activity Report. ",!!
10ASKDT S FBTYPE=6,%DT="EAP",%DT("A")="Enter Month and Year: " D ^%DT G END:X="^"!(X="") S X=Y X $S($E(X,6,7)'="00":"K X W !,""Do not specify day of month""",X>DT:"K X W !,""Not future dates""",1:"") I '$D(X) G ASKDT
11 S FBCHDT=X D DAYS^FBAAUTL1 S FBENDDT=FBCHDT+X
12 S VAR="FBCHDT^FBENDDT^FBK^FBHED",VAL=FBCHDT_"^"_FBENDDT_"^"_FBK_"^"_FBHED,PGM="START^FBCHACT" D ZIS^FBAAUTL G:FBPOP END
13START U IO W:$E(IOST,1,2)["C-" @IOF S DCNT=0,FBTYPE=6 K ^TMP("FBCH",$J)
14 F I=FBCHDT:0 S I=$O(^FB7078("AD",FBTYPE,I)) Q:I'>0!(I>FBENDDT) F J=0:0 S J=$O(^FB7078("AD",FBTYPE,I,J)) Q:J'>0 D VENTYPE I FBVENTP S DCNT=DCNT+1,^TMP("FBCH",$J,"AD",FBVENTP,J,I)=""
15 S ACNT=0
16 F I=FBCHDT:0 S I=$O(^FB7078("AA",FBTYPE,I)) Q:I'>0!(I>FBENDDT) F J=0:0 S J=$O(^FB7078("AA",FBTYPE,I,J)) Q:J'>0 D VENTYPE I FBVENTP S ACNT=ACNT+1,^TMP("FBCH",$J,"AA",FBVENTP,J,I)=""
17 S RCNT=0
18 F K=0:0 S K=$O(^FB7078("AA",FBTYPE,K)) Q:K'>0!(K>FBENDDT) F J=0:0 S J=$O(^FB7078("AA",FBTYPE,K,J)) Q:J'>0 I $P(^FB7078(J,0),"^",5)]""&($P(^(0),"^",5)>FBENDDT) D VENTYPE I FBVENTP S RCNT=RCNT+1,^TMP("FBCH",$J,"AR",FBVENTP,J,K)=""
19 I $D(^FB7078("AC","I")) F I=0:0 S I=$O(^FB7078("AC","I",I)) Q:I'>0 F J=0:0 S J=$O(^FB7078("AC","I",I,J)) Q:J'>0 D VENTYPE I FBVENTP S RCNT=RCNT+1
20 D ^FBCHACT1,^FBCHACT0
21END K ACNT,DCNT,RCNT,DUOUT,DTOUT,DIRUT,I,J,K,L,Q,QQ,FBK,FBHED,X,Y,FBCHDT,FBENDDT,^TMP("FBCH",$J),ZZ,FBADMIT,FB,FBBED,PTYPE,VTYPE,DAYS,^TMP("FB",$J),FBVENTP
22 D CLOSE^FBAAUTL Q
23VENTYPE ;GET VENDOR TYPE
24 S FBVENTP="" Q:'J Q:'$D(^FB7078(J,0))
25 Q:$P($G(^FB7078(J,0)),U,9)="DC"
26 S FBVENTP=$S($P($P(^FB7078(J,0),"^",2),";",2)="FBAAV(":$P($P(^(0),"^",2),";",1),1:""),FBVENTP=$S(FBVENTP="":"",1:$S($D(^FBAAV(FBVENTP,0)):$P(^(0),"^",7),1:""))
27 I FBVENTP="" S FBVENTP=1
28 Q
Note: See TracBrowser for help on using the repository browser.