| 1 | FBNHAMIS ;AISC/GRR-CALCULATE AMIS 349 ;18DEC00
|
|---|
| 2 | ;;3.5;FEE BASIS;**12,25**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D DT^DICRW S %DT="AEPMX",%DT(0)=-$E(DT,1,5)_31,%DT("A")="Calculate AMIS for which Month/Year: " D ^%DT G:X=""!(X="^") END S FBPAYDT=$E(+Y,1,5)_"00",FBMM=$E(+Y,4,5),FBYY=$E(+Y,2,3),X=+Y D DAYS^FBAAUTL1
|
|---|
| 5 | W ! S FBDAYS=X,FBENDDT=$E(+Y,1,5)_FBDAYS+.9
|
|---|
| 6 | S DIR(0)="Y",DIR("A")="Do you want data validation with this output",DIR("B")="No",DIR("?")="Answering 'Yes' will print who is found for each AMIS segment." D ^DIR K DIR G:$D(DIRUT) END I Y S FBVAL=1
|
|---|
| 7 | S VAR="FBPAYDT^FBENDDT^FBDAYS^FBYY^FBVAL",VAL=FBPAYDT_"^"_FBENDDT_"^"_FBDAYS_"^"_FBYY_"^"_$G(FBVAL),PGM="START^FBNHAMIS",IOP="Q" D ZIS^FBAAUTL G:FBPOP END W !
|
|---|
| 8 | START K FBOUT U IO D PRIOR
|
|---|
| 9 | K ^TMP($J,"FBAMIS") S FBCUR=1 ;current month flag
|
|---|
| 10 | F I=1:1:4 S FBG(I)=0
|
|---|
| 11 | F I=1:1:4 S FBL(I)=0
|
|---|
| 12 | F I=1,2,3 S FBR(I)=0
|
|---|
| 13 | S (FBASDIS,FBASDEAD,FBTRDYS,FBSC,FBFEM,TOTDAYS)=0,FBMONTH=$E(FBPAYDT,1,5)_"01^"_$E(FBENDDT,1,7)
|
|---|
| 14 | F FBJ=FBPAYDT:0 S FBJ=$O(^FBAACNH("B",FBJ)) Q:FBJ'>0!(FBJ>FBENDDT) F FBIFN=0:0 S FBIFN=$O(^FBAACNH("B",FBJ,FBIFN)) Q:'FBIFN I $D(^FBAACNH(FBIFN,0)) S Y(0)=^(0),FBTYPE=$P(Y(0),"^",3) D ADD:FBTYPE="A",TRAN:FBTYPE="T",DIS:FBTYPE="D"
|
|---|
| 15 | G ^FBNHAMI1
|
|---|
| 16 | END K %DT,FB,FBSW,FBG,FBL,FBR,IFN,DFN,FBLTT,FBNAC,FBPNAC,FBZ,FBPRTR,FBDD,FBENDDT,FBPAYDT,FBDAYS,TOTDAYS,FBRIFN,FBPIFN,FBTRDYS,FBFEM,FBSC,FBASIH,Z,Y,FBJ,FBTYPE,ATYPE,DTYPE,TTYPE,VAR,VAL,PGM,FBCUR,FBCHK,FBPRIOR,FBMOV,FBPG
|
|---|
| 17 | K FBABD,FBASDEAD,FBASDIS,FBDEFP,FBEDT,FBERR,FBHIFN,FBIFN,FBIRAT,FBMM,FBMONTH,FBMULT,FBNHCC,FBONE,FBPREV,FBSRAT,FBSUB,FBTDT,FBTOTAL,FBTWO,FBUL,FBVCAR,FBYY,I,X,X1,Z1,Z2,FBTOT,FBCOUNT,FBPSW,FBER,FBZZ,FBVAL,FBDV,FBOUT,^TMP($J,"FBAMIS")
|
|---|
| 18 | D CLOSE^FBAAUTL
|
|---|
| 19 | Q
|
|---|
| 20 | PRIOR ;calculate bed occupants remaining from previous month's amis
|
|---|
| 21 | S FBPAYHDT=FBPAYDT
|
|---|
| 22 | N FBR,FBPAYDT,FBENDDT,FBDAYS,FBMM,FBYY,FBYYY,FBFEM,FBTRDYS
|
|---|
| 23 | F I=1,2,3 S FBR(I)=0
|
|---|
| 24 | S (FBFEM,FBTRDYS)=0
|
|---|
| 25 | S FBMM=$E(FBPAYHDT,4,5),FBYYY=$E(FBPAYHDT,1,3)
|
|---|
| 26 | S FBMM=FBMM-1
|
|---|
| 27 | I FBMM<1 S FBMM=12,FBYYY=FBYYY-1
|
|---|
| 28 | I $L(FBMM)=1 S FBMM="0"_FBMM
|
|---|
| 29 | I $L(FBYYY)<3 S FBYYY=$E("000",0,3-$L(FBYYY))_FBYYY
|
|---|
| 30 | S FBYY=$E(FBYYY,2,3)
|
|---|
| 31 | S FBPAYDT=FBYYY_FBMM_"00",X=+FBPAYDT D DAYS^FBAAUTL1 S FBDAYS=X
|
|---|
| 32 | S FBENDDT=$E(+FBPAYDT,1,5)_FBDAYS+.9
|
|---|
| 33 | D NEXT^FBNHAMI1
|
|---|
| 34 | S FBPRIOR=FBR(1)+FBR(2) K FBPAYHDT
|
|---|
| 35 | Q
|
|---|
| 36 | ADD S ATYPE=$P(Y(0),"^",6) Q:ATYPE=""
|
|---|
| 37 | S FBSUB=$S(ATYPE=1:1,ATYPE=2:3,1:2),FBG(FBSUB)=FBG(FBSUB)+1 D TMP^FBNHAMI1(FBSUB)
|
|---|
| 38 | S DFN=$P(Y(0),"^",2) I $$EXTPV^FBAAUTL5($P($G(^FBAAA(DFN,1,+$P(Y(0),"^",10),0)),"^",7))=40 S FBSC=FBSC+1 D TMP^FBNHAMI1(16)
|
|---|
| 39 | Q
|
|---|
| 40 | DIS S DTYPE=$P(Y(0),"^",8) Q:DTYPE=""
|
|---|
| 41 | I DTYPE<4!(DTYPE=6) S FBSUB=$S(DTYPE=1:1,DTYPE=6:1,1:DTYPE),FBL(FBSUB)=FBL(FBSUB)+1 D TMP^FBNHAMI1(FBSUB+4) Q
|
|---|
| 42 | I DTYPE=4 S FBASDIS=FBASDIS+1 D TMP^FBNHAMI1(13) Q
|
|---|
| 43 | S FBASDEAD=FBASDEAD+1 D TMP^FBNHAMI1(14)
|
|---|
| 44 | Q
|
|---|
| 45 | TRAN S TTYPE=$P(Y(0),"^",7) Q:TTYPE=""
|
|---|
| 46 | I TTYPE=6 S FBG(4)=FBG(4)+1 D TMP^FBNHAMI1(4) Q
|
|---|
| 47 | I TTYPE=3 S FBL(4)=FBL(4)+1 D TMP^FBNHAMI1(8) Q
|
|---|
| 48 | Q
|
|---|
| 49 | DISCR ;print out pts whose authorization dates have been exceeded
|
|---|
| 50 | Q:'$D(FBER)
|
|---|
| 51 | W @IOF D HDR^FBNHPAMS
|
|---|
| 52 | W !?5,">>>NOTICE OF INCOMPLETE PATIENT MOVEMENTS AFFECTING AMIS TOTALS<<<",!!!,"The following patient(s) have met or exceeded their authorizations, and have",!,"not been discharged. This will result in inaccurate AMIS 349 calculations"
|
|---|
| 53 | W !,"for the current month's amis, and will affect the balancing segment for",!,"subsequent months!!",!!,"To obtain an accurate AMIS, you must either discharge the patient,"
|
|---|
| 54 | W !,"or extend their Authorization To Date. Once the data has been corrected,",!,"you may run the AMIS 349 again to obtain accurate figures."
|
|---|
| 55 | W !!?10,"PATIENT",?44,"PT. ID",?55,"AUTHORIZATION TO DATE",!
|
|---|
| 56 | S FBZ=0 F S FBZ=$O(FBER(FBZ)) Q:'FBZ!($G(FBOUT)) S FBDD=0 F S FBDD=$O(FBER(FBZ,FBDD)) Q:'FBDD!($G(FBOUT)) D PGCK^FBNHPAMS(3) Q:$G(FBOUT) D
|
|---|
| 57 | .W !,$S(FBER(FBZ,FBDD)=1:"",1:"**"),?5,$$NAME^FBCHREQ2(FBZ),?40,$$SSN^FBAAUTL(FBZ),?60,$$DATX^FBAAUTL(FBDD) I FBER(FBZ,FBDD)="" S FBMOV=1
|
|---|
| 58 | I $G(FBMOV) D PGCK^FBNHPAMS(4) Q:$G(FBOUT) W !!,"** indicates movement problem from the prior month that is affecting",!,"the balancing segment."
|
|---|
| 59 | Q
|
|---|
