source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBNHEA.m@ 1147

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1FBNHEA ;AISC/GRR-ENTER ADMISSION TO NURSING HOME ;8/18/2004
2 ;;3.5;FEE BASIS;**82**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4RD1 D GETVET^FBAAUTL1 G:DFN']"" Q
5 I $D(^FBAACNH("AD",DFN)) G CKVEIW
6RD0 S FBPROG="I $P(^(0),U,3)=7" D GETAUTH^FBAAUTL1 G RD1:FTP']"",RD1:$D(DUOUT),H^XUS:$D(DTOUT) I FBTYPE'=7 D WRONGT^FBAAUTL1 G RD0
7RD2 I $D(^FBAACNH("AD",DFN)) G CKVEIW
8 S FBLTD=$O(^FBAACNH("AF",DFN,0)) K:FBLTD<1 FBLTD S FBTRT="A",DIR(0)="DA^"_FBAABDT_".000001:"_FBAABDT_".999999:EXR",DIR("A")="Enter Admission Date/Time: ",DIR("?")="Enter date pt. admitted to CNH facility (time is required)"
9 D ^DIR K DIR G:$D(DIRUT)!'Y Q S FBY=+Y D DATCK2^FBAAUTL1 G:'$D(X) RD2
10 S DIR(0)="S^1:AFTER RE-HOSPITALIZATION >15 DAYS;2:TRANSFER FROM OTHER CNH;3:FROM ASIH <15 DAYS;4:ALL OTHER",DIR("A")="Enter Admission Type" D ^DIR K DIR G:$D(DIRUT) Q S FBZ=+Y
11 K DD,DO S X=FBY,DIC="^FBAACNH(",DIE=DIC,DIC(0)="LM",DLAYGO=162.3 D FILE^DICN G RD1:$D(DUOUT)!($D(DTOUT)),RD2:Y<0 S DA=+Y K DIC,DLAYGO
12 S DR="8////^S X=FBVEN;Q;9////^S X=FTP;1////^S X=DFN;2////^S X=""A"";3////^S X=""Y"";4////^S X=DA;5////^S X=FBZ" L +FBAACNH(DA) D ^DIE L -FBAACNH(DA) I '$D(DTOUT) D PTFC^FBUTL6(DFN,FBY) I '$G(FBRCHK) G RD1
13Q K DIC,DIE,DR,DA,DFN,FBTYPE,FTP,Y,X,FBPROG,FBVEN,CNT,DAT,F,FB7078,FBAABDT,FBAAEDT,FBAAOUT,FBASSOC,FBAUT,FBDX,FBI,FBLOC,FBPOV,FBPSA,FBPT,I,FBRR,FBTT,PI,PTYPE,T,TA,Z,ZZ,CNT,FBAUT,TA,DIRUT,DUOUT,DTOUT,FBY,FBLTD,FBTRT
14 K FBZ,FBRCHK
15 Q
16CKVEIW W !!,*7,"Veteran already has an active admission, you may use the edit option to edit it.",!
17 S DIR(0)="Y",DIR("A")="Want data related to active admission displayed",DIR("B")="NO" D ^DIR K DIR I Y S IFN=$O(^FBAACNH("AD",DFN,0)) D ^FBNHDEC
18 I '$G(FBRCHK) G RD1
19 Q
Note: See TracBrowser for help on using the repository browser.