source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBNHEXP.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1FBNHEXP ;AISC/CMR CNH WITH CONTRACT EXPIRING WITHIN DATE RANGE;10MAR93
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 S %DT="AEX" D DATE^FBAAUTL K %DT G END:$G(FBPOP)
5 W !,"This option will list nursing homes with contracts expiring between",!,$$DATX^FBAAUTL(BEGDATE)," and ",$$DATX^FBAAUTL(ENDDATE),".",!
6 S DIR("A")="Are you sure you want to continue",DIR(0)="Y",DIR("B")="Yes" D ^DIR K DIR G END:$D(DIRUT)!(Y=0)
7 S VAR="BEGDATE^ENDDATE",VAL=BEGDATE_"^"_ENDDATE,PGM="START^FBNHEXP" D ZIS^FBAAUTL G END:FBPOP
8 ;
9START S Q="",$P(Q,"=",80)="=",FBAAOUT=0 U IO W:$E(IOST,1,2)["C-" @IOF D HED
10 F FBV=0:0 S FBV=$O(^FBAA(161.21,"ADR",FBV)) Q:FBV'>0!(FBAAOUT) F FBDT=-(ENDDATE+.001):0 S FBDT=$O(^FBAA(161.21,"ADR",FBV,FBDT)) Q:FBDT=""!(FBDT>-BEGDATE)!(FBAAOUT) F FBI=0:0 S FBI=$O(^FBAA(161.21,"ADR",FBV,FBDT,FBI)) Q:FBI'>0!(FBAAOUT) D
11 .I $Y+4>IOSL,($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
12 .I $Y+4>IOSL W @IOF D HED
13 .W !,$$VNAME(FBV),?47,$$VID(FBV),?58,$P(^FBAA(161.21,FBI,0),"^"),?72,$$DATX^FBAAUTL($P(^(0),"^",3))
14END I '$G(FBAAOUT),'$G(FBPOP),$E(IOST,1,2)="C-" W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
15 K BEGDATE,ENDDATE,FBAAOUT,FBDT,FBI,FBV,Q,X,Y
16 D CLOSE^FBAAUTL
17 Q
18HED W !?12,"CNH CONTRACTS EXPIRING BETWEEN ",$$DATX^FBAAUTL(BEGDATE)," AND ",$$DATX^FBAAUTL(ENDDATE)
19 W !?12,$E(Q,1,52),!!!,"Vendor Name",?47,"Vendor ID",?58,"Contract #",?72,"Exp. Dt.",!,Q
20 Q
21VNAME(X) ;INPUT - VENDOR IEN
22 ;OUTPUTS VENDOR NAME
23 I $G(X),$D(^FBAAV(X,0)) Q $P(^(0),"^")
24 Q "UNKNOWN"
25 ;
26VID(X) ;INPUT - VENDOR IEN
27 ;OUTPUTS VENDOR ID
28 I $G(X),$D(^FBAAV(X,0)) Q $P(^(0),"^",2)
29 Q "UNKNOWN"
Note: See TracBrowser for help on using the repository browser.