source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBNHROS.m@ 1495

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1FBNHROS ;AISC/GRR-PRINT NURSING HOME ROSTERS ;16MAY90
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 W !!,"This option will print Nursing Home Rosters.",!
5 S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="No" D ^DIR K DIR G END:$D(DUOUT),H^XUS:$D(DTOUT),END:Y=0
6 S (VAL,VAR)="",PGM="START^FBNHROS" D ZIS^FBAAUTL G:FBPOP END
7START U IO W:$E(IOST,1,2)["C-" @IOF K ^TMP($J)
8 N FBA,FBAAOUT,FBAD,FBCH,FBDASH,FBDFN,FBHED,FBI,FBP,FBPNAM,FBSSN,FBTD,FBV,FBVIEN,FBVNAM ;new variables here
9 S $P(FBDASH,"-",80)="",FBAAOUT=0
10 F FBDFN=0:0 S FBDFN=$O(^FBAACNH("AD",FBDFN)) Q:FBDFN'>0 S FBI=+$O(^FBAACNH("AD",FBDFN,0)) S FBI(0)=$G(^FBAACNH(FBI,0)) I FBI(0)]"" D
11 .S FBVIEN=$P(FBI(0),U,9),FBVNAM=$$PTR^FBUCUTL("^FBAAV(",FBVIEN),FBPNAM=$$PTR^FBUCUTL("^DPT(",FBDFN),^TMP($J,$P(FBVNAM,U)_";"_FBVIEN,$P(FBPNAM,U)_";"_FBDFN)=FBI
12 D HEADER
13 S FBV="" F S FBV=$O(^TMP($J,FBV)) Q:FBV=""!(FBAAOUT) S FBHED=1 S FBP="" F S FBP=$O(^TMP($J,FBV,FBP)) Q:FBP=""!(FBAAOUT) S FBVNAM=$P(FBV,";"),FBVIEN=$P(FBV,";",2),FBDFN=$P(FBP,";",2),FBI=+$G(^TMP($J,FBV,FBP)) D
14 .S FBSSN=$$SSN^FBAAUTL(FBDFN),FBCH(0)=$G(^FBAACNH(FBI,0)),FBAD=$P(FBCH(0),U),FBAD=$E(FBAD,1,7),FBA=$P(FBCH(0),U,10),FBTD=$S(FBA="":"",1:$P($G(^FBAAA(FBDFN,1,+FBA,0)),U,2))
15 .I $Y+4>IOSL&($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
16 .I $Y+4>IOSL W @IOF D HEADER,HED
17 .D:FBHED HED
18 .W !?4,$P(FBP,";"),?37,FBSSN,?53,$$DATX^FBAAUTL(FBAD),?66,$$DATX^FBAAUTL(FBTD)
19END W ! K DIR,DIRUT,DTOUT,DUOUT,I,PGM,VAL,VAR,Y,^TMP($J)
20 D CLOSE^FBAAUTL Q
21HED S FBHED=0 W !!,FBVNAM,?50,$$VID^FBNHEXP(FBVIEN)
22 Q
23HEADER W !?20,"Nursing Home Roster - ",$$PDATE^FBUCUTL2(DT),!?19,$E(FBDASH,1,41),!,"VENDOR NAME",?50,"VENDOR ID",!,?4,"VETERAN NAME",?37,"VETERAN ID",?53,"ADMIT DT",?65,"AUTH TO DATE",!
24 W !,FBDASH Q
Note: See TracBrowser for help on using the repository browser.