| 1 | FBNHDLAD ;AISC/GRR-DELETE ADMISSION FOR 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.
|
|---|
| 4 | RD1 D GETVET^FBAAUTL1 G:DFN']"" Q W !
|
|---|
| 5 | 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
|
|---|
| 6 | S FB("ADDT")=$P(Y(0),"^") ; admission date/time
|
|---|
| 7 | S FB(161)=$P(Y(0),"^",10)
|
|---|
| 8 | I $O(^FBAACNH("AC",DA,DA))>0 W !!,*7,"Other movements associated with this admission are still on file.",!,"You cannot delete the admission when other movements exist!" G CKVEIW
|
|---|
| 9 | S DIR("A")="Are you sure you want to delete this admission",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR G H^XUS:$D(DTOUT),Q:$D(DUOUT),RD1:Y=0
|
|---|
| 10 | I FB(161),$D(^FBAAA(DFN,1,FB(161),0)) S FB(78)=$P($P(^(0),"^",9),";")
|
|---|
| 11 | I $G(FB(78)) S FB(1625)=+$O(^FBAAI("E",FB(78)_";FB7078(",0))
|
|---|
| 12 | I $G(FB(1625)),$D(^FBAAI(FB(1625),0)) W *7,!,"Unable to delete. Payments already made against this admission!",!! G RD1
|
|---|
| 13 | S DIK=DIE D ^DIK K DIK W !?5,"...deleted",!
|
|---|
| 14 | D PTFD^FBUTL6(DFN,FB("ADDT")) ; delete associated PTF record
|
|---|
| 15 | K FB
|
|---|
| 16 | G RD1
|
|---|
| 17 | Q K DIC,DIE,DR,DA,DFN,FBTYPE,FTP,Y,X,FBPROG,FB,FBZZ,ZZZ
|
|---|
| 18 | Q
|
|---|
| 19 | CKVEIW S DIR("A")="Want data related to this admission displayed",DIR("B")="No",DIR(0)="Y" D ^DIR K DIR G H^XUS:$D(DTOUT),RD1:$D(DUOUT)!(Y=0) S IFN=DA D ^FBNHDEC
|
|---|
| 20 | G RD1
|
|---|
