FBNHEDAD.m

FBNHEDAD ;AISC/GRR - EDIT ADMISSION TYPE FOR NURSING HOME ;1/22/15  14:49

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

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

RD1 D GETVET^FBAAUTL1 G:DFN']"" Q

RD2 S DIC("S")="I $P(^(0),U,3)=""A""&($P(^(0),U,2)=DFN)",DIC="^FBAACNH(",DIE=DIC,DIC(0)="AEQMZ",DLAYGO=162.3,DIC("A")="Select Admission Date/Time: " D ^DIC K DIC,DLAYGO G RD1:X="^"!(X=""),RD2:Y<0 S DA=+Y

 S DR="5;8" D ^DIE

 D

 . N FB,FBX,DTOUT

 . S FB(161)=$S(DA:$P($G(^FBAACNH(DA,0)),"^",10),1:"")

 . Q:'FB(161)

 . I $D(^FBAAA(DFN,1,FB(161),0)) S FB(78)=+$P(^(0),"^",9)

 . Q:'$G(FB(78))

 . S FBX=$$ADDUA^FBUTL9(162.4,FB(78)_",","Edit CNH admission.")

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

 G RD1:'$D(DTOUT)

Q K DIC,DIE,DR,DA,DFN,FBTYPE,FTP,Y,X,FBPROG

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBNHEDAD   823     printed  Apr 09, 2024@21:04:14                                                                                                                                                                                                     Page 2

FBNHEDAD  ;AISC/GRR - EDIT ADMISSION TYPE FOR NURSING HOME ;1/22/15  14:49

 +1       ;;3.5;FEE BASIS;**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

RD2        SET DIC("S")="I $P(^(0),U,3)=""A""&($P(^(0),U,2)=DFN)"

           SET DIC="^FBAACNH("

           SET DIE=DIC

           SET DIC(0)="AEQMZ"

           SET DLAYGO=162.3

           SET DIC("A")="Select Admission Date/Time: "

           DO ^DIC

           KILL DIC,DLAYGO

           if X="^"!(X="")

               GOTO RD1

           if Y<0

               GOTO RD2

           SET DA=+Y

 +1        SET DR="5;8"

           DO ^DIE

 +2        Begin DoDot:1

 +3            NEW FB,FBX,DTOUT

 +4            SET FB(161)=$SELECT(DA:$PIECE($GET(^FBAACNH(DA,0)),"^",10),1:"")

 +5            if 'FB(161)

                   QUIT 

 +6            IF $DATA(^FBAAA(DFN,1,FB(161),0))

                   SET FB(78)=+$PIECE(^(0),"^",9)

 +7            if '$GET(FB(78))

                   QUIT 

 +8            SET FBX=$$ADDUA^FBUTL9(162.4,FB(78)_",","Edit CNH admission.")

 +9            IF 'FBX

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

           End DoDot:1

 +10       if '$DATA(DTOUT)

               GOTO RD1

Q          KILL DIC,DIE,DR,DA,DFN,FBTYPE,FTP,Y,X,FBPROG

 +1        QUIT