source: FOIAVistA/tag/r/FEE_BASIS-FB/FBNHROS.m@ 628

FBNHROS ;AISC/GRR-PRINT NURSING HOME ROSTERS ;16MAY90
 ;;3.5;FEE BASIS;;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 W !!,"This option will print Nursing Home Rosters.",!
 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
 S (VAL,VAR)="",PGM="START^FBNHROS" D ZIS^FBAAUTL G:FBPOP END
START U IO W:$E(IOST,1,2)["C-" @IOF K ^TMP($J)
 N FBA,FBAAOUT,FBAD,FBCH,FBDASH,FBDFN,FBHED,FBI,FBP,FBPNAM,FBSSN,FBTD,FBV,FBVIEN,FBVNAM ;new variables here
 S $P(FBDASH,"-",80)="",FBAAOUT=0
 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
 .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
 D HEADER
 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
 .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))
 .I $Y+4>IOSL&($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
 .I $Y+4>IOSL W @IOF D HEADER,HED
 .D:FBHED HED
 .W !?4,$P(FBP,";"),?37,FBSSN,?53,$$DATX^FBAAUTL(FBAD),?66,$$DATX^FBAAUTL(FBTD)
END W ! K DIR,DIRUT,DTOUT,DUOUT,I,PGM,VAL,VAR,Y,^TMP($J)
 D CLOSE^FBAAUTL Q
HED S FBHED=0 W !!,FBVNAM,?50,$$VID^FBNHEXP(FBVIEN)
 Q
HEADER 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",!
 W !,FBDASH Q