| 1 | FBNHEDTR ;AISC/GRR-EDIT TRANSFER TYPE FOR NURSING HOME ;29AUG88
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | RD1 D GETVET^FBAAUTL1 G:DFN']"" Q
|
|---|
| 5 | ;
|
|---|
| 6 | RD2 S DIC("S")="I $P(^(0),U,3)=""T""&($P(^(0),U,2)=DFN)",DIC="^FBAACNH(",DIE=DIC,DIC(0)="AEQMZ",DLAYGO=162.3,DIC("A")="Select Transfer Date/Time: " D ^DIC K DIC,DLAYGO G RD1:X="^"!(X=""),RD2:Y<0 S (DA,IFN)=+Y,FBAADT=$P(Y,U,2)
|
|---|
| 7 | S FBDA=$P(Y(0),U,5) D I $G(FBERR) D Q G RD1
|
|---|
| 8 | . I $O(^FBAACNH("AC",FBDA,DA)) W !,*7,"There are movements following this transfer that must be deleted first.",!! S FBERR=1
|
|---|
| 9 | ;
|
|---|
| 10 | S FBTR=$P(Y(0),U,7),FBLTTYP=""
|
|---|
| 11 | S FBJ=9999999.999999-FBAADT F S FBJ=$O(^FBAACNH("AF",DFN,FBJ)) Q:'FBJ S FBK=$O(^FBAACNH("AF",DFN,FBJ,0)) I $P($G(^FBAACNH(FBK,0)),"^",5)=$P(^FBAACNH(DA,0),"^",5) D Q
|
|---|
| 12 | . S FBLTTYP=$P(^FBAACNH(FBK,0),U,7)
|
|---|
| 13 | S DR="@1;6;S FBNTR=X;D CHKTR^FBNHEDTR;6////^S X=FBTR;S Y=""@1"""
|
|---|
| 14 | D ^DIE K DIE G Q:$D(DTOUT)
|
|---|
| 15 | D Q G RD1
|
|---|
| 16 | ;
|
|---|
| 17 | Q K DIC,DIE,DR,DA,DFN,FBTYPE,FTP,Y,X,FBPROG,FBTR,FBNTR,IFN,FBAADT,FBJ,FBK,FBASIH,FBDA,FBERR,FBLTTYP
|
|---|
| 18 | Q
|
|---|
| 19 | CHKTR ;called from dr string to make sure that the transfer type is
|
|---|
| 20 | ;consistant, that is if the old transfer type (FBTR) is a loss
|
|---|
| 21 | ;then the new transfer type (FBNTR) is also a loss.
|
|---|
| 22 | ;
|
|---|
| 23 | I '$G(FBLTTYP),(FBTR>3&(FBNTR'>3)) D ERROR1 Q
|
|---|
| 24 | I '$G(FBLTTYP),(FBTR<4&(FBNTR'<4)) D ERROR Q
|
|---|
| 25 | S Y=""
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | ERROR ;write inconsistant movement type which will reset the movement type
|
|---|
| 29 | ;to original and allow user to re-edit.
|
|---|
| 30 | ;
|
|---|
| 31 | W !?5,*7,"Movement Type must be consistant. A transfer that is a loss",!?5,"may only be editted to another 'loss' type.",!
|
|---|
| 32 | Q
|
|---|
| 33 | ERROR1 ;write inconsistant movement type 'gain', reset transfer type and re-edit
|
|---|
| 34 | ;
|
|---|
| 35 | W !?5,*7,"Movement Type must be consistant. A transfer that is a gain",!?5,"may only be editted to another 'gain' type.",!
|
|---|
| 36 | Q
|
|---|
