VistA-FOIAVistA/r/FEE_BASIS-FB/FBNHEDTR.m

37 lines
1.8 KiB
Mathematica

FBNHEDTR ;AISC/GRR-EDIT TRANSFER TYPE FOR NURSING HOME ;29AUG88
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
RD1 D GETVET^FBAAUTL1 G:DFN']"" Q
;
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)
S FBDA=$P(Y(0),U,5) D I $G(FBERR) D Q G RD1
. I $O(^FBAACNH("AC",FBDA,DA)) W !,*7,"There are movements following this transfer that must be deleted first.",!! S FBERR=1
;
S FBTR=$P(Y(0),U,7),FBLTTYP=""
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
. S FBLTTYP=$P(^FBAACNH(FBK,0),U,7)
S DR="@1;6;S FBNTR=X;D CHKTR^FBNHEDTR;6////^S X=FBTR;S Y=""@1"""
D ^DIE K DIE G Q:$D(DTOUT)
D Q G RD1
;
Q K DIC,DIE,DR,DA,DFN,FBTYPE,FTP,Y,X,FBPROG,FBTR,FBNTR,IFN,FBAADT,FBJ,FBK,FBASIH,FBDA,FBERR,FBLTTYP
Q
CHKTR ;called from dr string to make sure that the transfer type is
;consistant, that is if the old transfer type (FBTR) is a loss
;then the new transfer type (FBNTR) is also a loss.
;
I '$G(FBLTTYP),(FBTR>3&(FBNTR'>3)) D ERROR1 Q
I '$G(FBLTTYP),(FBTR<4&(FBNTR'<4)) D ERROR Q
S Y=""
Q
;
ERROR ;write inconsistant movement type which will reset the movement type
;to original and allow user to re-edit.
;
W !?5,*7,"Movement Type must be consistant. A transfer that is a loss",!?5,"may only be editted to another 'loss' type.",!
Q
ERROR1 ;write inconsistant movement type 'gain', reset transfer type and re-edit
;
W !?5,*7,"Movement Type must be consistant. A transfer that is a gain",!?5,"may only be editted to another 'gain' type.",!
Q