FBNHEA.m

FBNHEA ;AISC/GRR - ENTER ADMISSION TO NURSING HOME ;1/22/15  14:23

 ;;3.5;FEE BASIS;**82,108,154**;JAN 30, 1995;Build 12

 ;;Per VA Directive 6402, 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),Q:$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

 D

 . N FBX,DIE,DA

 . S FBX=$$ADDUA^FBUTL9(162.4,FB7078_",","Enter CNH admission.")

 . I 'FBX W !,"Error adding record in User Audit. Please contact IRM."

 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" D ^DIE 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

 D GETAUTHK^FBAAUTL1

 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBNHEA   1905     printed  Apr 09, 2024@21:05:04                                                                                                                                                                                                      Page 2

FBNHEA    ;AISC/GRR - ENTER ADMISSION TO NURSING HOME ;1/22/15  14:23

 +1       ;;3.5;FEE BASIS;**82,108,154**;JAN 30, 1995;Build 12

 +2       ;;Per VA Directive 6402, this routine should not be modified.

RD1        DO GETVET^FBAAUTL1

           if DFN']""

               GOTO Q

 +1        IF $DATA(^FBAACNH("AD",DFN))

               GOTO CKVEIW

RD0        SET FBPROG="I $P(^(0),U,3)=7"

           DO GETAUTH^FBAAUTL1

           if FTP']""

               GOTO RD1

           if $DATA(DUOUT)

               GOTO RD1

           if $DATA(DTOUT)

               GOTO Q

           IF FBTYPE'=7

               DO WRONGT^FBAAUTL1

               GOTO RD0

RD2        IF $DATA(^FBAACNH("AD",DFN))

               GOTO CKVEIW

 +1        SET FBLTD=$ORDER(^FBAACNH("AF",DFN,0))

           if FBLTD<1

               KILL FBLTD

           SET FBTRT="A"

           SET DIR(0)="DA^"_FBAABDT_".000001:"_FBAABDT_".999999:EXR"

           SET DIR("A")="Enter Admission Date/Time:  "

           SET DIR("?")="Enter date pt. admitted to CNH facility (time is required)"

 +2        DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!'Y

               GOTO Q

           SET FBY=+Y

           DO DATCK2^FBAAUTL1

           if '$DATA(X)

               GOTO RD2

 +3        SET DIR(0)="S^1:AFTER RE-HOSPITALIZATION >15 DAYS;2:TRANSFER FROM OTHER CNH;3:FROM ASIH <15 DAYS;4:ALL OTHER"

           SET DIR("A")="Enter Admission Type"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO Q

           SET FBZ=+Y

 +4        KILL DD,DO

           SET X=FBY

           SET DIC="^FBAACNH("

           SET DIE=DIC

           SET DIC(0)="LM"

           SET DLAYGO=162.3

           DO FILE^DICN

           if $DATA(DUOUT)!($DATA(DTOUT))

               GOTO RD1

           if Y<0

               GOTO RD2

           SET DA=+Y

           KILL DIC,DLAYGO

 +5        Begin DoDot:1

 +6            NEW FBX,DIE,DA

 +7            SET FBX=$$ADDUA^FBUTL9(162.4,FB7078_",","Enter CNH admission.")

 +8            IF 'FBX

                   WRITE !,"Error adding record in User Audit. Please contact IRM."

           End DoDot:1

 +9        SET 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"

           DO ^DIE

           IF '$DATA(DTOUT)

               DO PTFC^FBUTL6(DFN,FBY)

               IF '$GET(FBRCHK)

                   GOTO RD1

Q          KILL 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

 +1        KILL FBZ,FBRCHK

 +2        DO GETAUTHK^FBAAUTL1

 +3        QUIT 

CKVEIW     WRITE !!,*7,"Veteran already has an active admission, you may use the edit option to edit it.",!

 +1        SET DIR(0)="Y"

           SET DIR("A")="Want data related to active admission displayed"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           IF Y

               SET IFN=$ORDER(^FBAACNH("AD",DFN,0))

               DO ^FBNHDEC

 +2        IF '$GET(FBRCHK)

               GOTO RD1

 +3        QUIT