| 1 | FBNHAMI2 ;AISC/CMR-CNH STAYS IN EXCESS OF 90 DAYS ;1DEC00
|
|---|
| 2 | ;;3.5;FEE BASIS;**25**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | W !!,"Use of this option will provide you with all 'ACTIVE' stays that are in excess",!,"of 90 days. The active stays are as of the date you choose.",!
|
|---|
| 5 | S %DT="APEX",%DT("A")="Enter Effective Date : " D ^%DT G END:Y<0 S FBDT=Y
|
|---|
| 6 | S VAR="FBDT",VAL=FBDT,PGM="START^FBNHAMI2" D ZIS^FBAAUTL G END:FBPOP
|
|---|
| 7 | START K ^TMP($J,"FBSTAY") S FBHD="=",$P(FBHD,"=",80)="=",FBUL="-",$P(FBUL,"-",37)="-" U IO W:$E(IOST,1,2)["C-" @IOF D HED
|
|---|
| 8 | S (FBADM,FBASSOC)=0
|
|---|
| 9 | F S FBADM=$O(^FBAACNH("AC",FBADM)) Q:'FBADM S FBCHK=0 D I FBCHK=0 D SET
|
|---|
| 10 | .F S FBASSOC=$O(^FBAACNH("AC",FBADM,FBASSOC)) Q:'FBASSOC D
|
|---|
| 11 | ..Q:FBADM=FBASSOC
|
|---|
| 12 | ..S FBI=$G(^FBAACNH(FBASSOC,0)),FBTYPE=$P(FBI,"^",3) Q:FBTYPE'="D" S FBDDT=$P(FBI,"^") I FBDDT'>FBDT S FBCHK=1
|
|---|
| 13 | S FBNAME=""
|
|---|
| 14 | F S FBNAME=$O(^TMP($J,"FBSTAY",FBNAME)) Q:FBNAME']""!($G(FBAAOUT)) S DFN=0 F S DFN=$O(^TMP($J,"FBSTAY",FBNAME,DFN)) Q:'DFN!($G(FBAAOUT)) D
|
|---|
| 15 | .S FBI=^TMP($J,"FBSTAY",FBNAME,DFN),FBID=$P(FBI,"^"),FBADT=$P(FBI,"^",2),FBVNAME=$P(FBI,"^",3),FBLOS=$P(FBI,"^",4) D PRINT
|
|---|
| 16 | G END:$G(FBAAOUT)
|
|---|
| 17 | W !!?5,"***LOS = Length of Stay as of ",$$DATX^FBAAUTL(FBDT)
|
|---|
| 18 | I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
|
|---|
| 19 | END ;
|
|---|
| 20 | K %DT,FBDT,FBAAOUT,DFN,FBNAME,FBID,FBVNAME,FBHD,FBTYPE,FBUL,VAR,VAL,PGM,FBPOP,FBADM,FBASSOC,FBCHK,FBI,FBDDT,FBADT,FBLOS,^TMP($J,"FBSTAY"),FBMS,VA,VADM
|
|---|
| 21 | D CLOSE^FBAAUTL
|
|---|
| 22 | Q
|
|---|
| 23 | SET ;SETS UP TMP GLOBAL
|
|---|
| 24 | S FBADT=+^FBAACNH(FBADM,0)
|
|---|
| 25 | S FBLOS=$$DTC^FBUCUTL(FBDT,FBADT)
|
|---|
| 26 | Q:FBLOS<90
|
|---|
| 27 | S FBI=$G(^FBAACNH(FBADM,0)),DFN=$P(FBI,"^",2) Q:'$G(DFN) S FBNAME=$$NAME^FBCHREQ2(DFN),FBID=$$SSN^FBAAUTL(DFN),FBVNAME=$P($G(^FBAAV($P(FBI,"^",9),0)),"^")
|
|---|
| 28 | S ^TMP($J,"FBSTAY",FBNAME,DFN)=FBID_"^"_FBADT_"^"_FBVNAME_"^"_FBLOS_"^"_DFN
|
|---|
| 29 | K FBNAME,FBID,FBVNAME,FBLOS,DFN Q
|
|---|
| 30 | PRINT ;
|
|---|
| 31 | I $E(IOST,1,2)["C-",$Y+2>IOSL S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
|
|---|
| 32 | I $Y+2>IOSL W @IOF D HED
|
|---|
| 33 | W !,$E(FBNAME,1,15),?18,FBID
|
|---|
| 34 | D DEM^VADPT S FBMS=$E($P(VADM(10),"^",2),1) K VA,VADM
|
|---|
| 35 | W ?32,FBMS,?35,$$DATX^FBAAUTL($E(FBADT,1,7)),?45,$J(FBLOS,6),?53,$E(FBVNAME,1,27)
|
|---|
| 36 | Q
|
|---|
| 37 | HED ;
|
|---|
| 38 | W !?22,"ACTIVE CNH STAYS IN EXCESS OF 90 DAYS",!?33,"AS OF ",$$DATX^FBAAUTL(FBDT),!?22,FBUL,!!
|
|---|
| 39 | W ?28,"MARITAL",!,"VETERAN",?20,"Pt. ID",?30,"ST.",?35,"ADM. DATE",?48,"LOS",?60,"VENDOR",!,FBHD
|
|---|
| 40 | Q
|
|---|
