20 lines
1.7 KiB
Mathematica
20 lines
1.7 KiB
Mathematica
FBNHEA ;AISC/GRR-ENTER ADMISSION TO NURSING HOME ;8/18/2004
|
|
;;3.5;FEE BASIS;**82**;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
RD1 D GETVET^FBAAUTL1 G:DFN']"" Q
|
|
I $D(^FBAACNH("AD",DFN)) G CKVEIW
|
|
RD0 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
|
|
RD2 I $D(^FBAACNH("AD",DFN)) G CKVEIW
|
|
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)"
|
|
D ^DIR K DIR G:$D(DIRUT)!'Y Q S FBY=+Y D DATCK2^FBAAUTL1 G:'$D(X) RD2
|
|
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
|
|
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
|
|
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
|
|
Q 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
|
|
K FBZ,FBRCHK
|
|
Q
|
|
CKVEIW W !!,*7,"Veteran already has an active admission, you may use the edit option to edit it.",!
|
|
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
|
|
I '$G(FBRCHK) G RD1
|
|
Q
|