| 1 | FBNHET ;AISC/GRR-ENTER TRANSFER FOR NURSING HOME ;09AUG89
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | RD1 D Q,GETVET^FBAAUTL1 G:DFN']"" Q
|
|---|
| 5 | I '$D(^FBAACNH("AD",DFN)) W !!,*7,"Veteran does NOT have an active admission!" G RD1
|
|---|
| 6 | RD0 S FBPROG="I $P(^(0),U,3)=7" D GETAUTH^FBAAUTL1 G RD1:FTP']"",RD1:$D(DUOUT),H^XUS:$D(DTOUT) I FBTYPE'=7 D WRONGT^FBAAUTL1 G RD0
|
|---|
| 7 | S IFN=$O(^FBAACNH("AD",DFN,0)),FBTRT="T",FBLTD=$O(^FBAACNH("AF",DFN,0)),FBIFN=$O(^FBAACNH("AF",DFN,FBLTD,0)),FBLTT=$P(^FBAACNH(FBIFN,0),"^",3),FBLTTYP=$S(FBLTT'="T":"",1:$P(^(0),"^",7))
|
|---|
| 8 | ;
|
|---|
| 9 | RD2 D ^FBNHDEC
|
|---|
| 10 | W ! S DIR(0)="DA^::EXR",DIR("A")="Enter Transfer Date/Time: ",DIR("?")="Enter date of transfer (time is required)" D ^DIR K DIR G:$D(DIRUT)!('Y) RD1
|
|---|
| 11 | I $D(FBTRT),$D(FBLTD),(9999999.999999-Y)'<FBLTD D G RD2:'$G(X)
|
|---|
| 12 | . W !,*7,"The date/time must follow an existing movement.",! H 2
|
|---|
| 13 | . K X
|
|---|
| 14 | S FBY=+Y
|
|---|
| 15 | S DIR(0)="S^1:TO AUTHORIZED ABSENCE;2:TO UN-AUTHORIZED ABSENCE;3:TO ASIH"
|
|---|
| 16 | S DIR(0)=$S('$G(FBLTTYP):DIR(0),FBLTTYP<4:"S^"_$P($T(TRANS+(3+FBLTTYP)),";;",2),1:DIR(0))
|
|---|
| 17 | S DIR("A")="Enter Transfer Type"
|
|---|
| 18 | I $G(FBLTTYP),FBLTTYP<4 S DIR("B")=$P($P(DIR(0),"^",2),":",2)
|
|---|
| 19 | D ^DIR K DIR
|
|---|
| 20 | G RD1:$D(DIRUT) S FBZ=+Y
|
|---|
| 21 | S (DIC,DIE)="^FBAACNH(",DIC(0)="L",DLAYGO=162.3,X=FBY
|
|---|
| 22 | K DD,DO D FILE^DICN K DLAYGO,DIC G RD1:$D(DIRUT),RD2:Y<0
|
|---|
| 23 | S DA=+Y L +^FBAACNH(DA)
|
|---|
| 24 | S DR="8////^S X=FBVEN;Q;1////^S X=DFN;2////^S X=""T"";4////^S X=IFN;6////^S X=FBZ" D ^DIE K DIE L -^FBAACNH(DA) I $D(Y)'=0 G DEL
|
|---|
| 25 | G RD1
|
|---|
| 26 | DEL W !!,*7,"Deleting Transfer because of incomplete transaction!" S DIK="^FBAACNH(" D ^DIK K DIK G RD1
|
|---|
| 27 | ;
|
|---|
| 28 | Q K FBLTT,FBLTTYP,FBINF,FBTRT,FBLTD,DFN,IFN,DIK,FBPROG,CNT,DAT,DIC,F,FBAUT,FBDX,FBEDT,FBI,FBMULT,FBRR,FBTDT,FBXX,FTP,I,PI,PTYPE,T,X,Z,ZZ,FBAAOUT,Y,FBAABDT,FB7078,FBAAEDT,FBAAOUT,FBASSOC,FBDX,FBI,FBPOV,FBY
|
|---|
| 29 | K FBPSA,FBPT,I,PI,PTYPE,T,TA,VAL,FBTT,FBLOC,FBAAAD,FBAT,FBIFN,FBPDT,FBTYPE,FBVEN,DA,DR,FBASIH,FBJ,FBK,FBZ
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | TRANS ;transfer types
|
|---|
| 33 | ;;1:TO AUTHORIZED ABSENCE
|
|---|
| 34 | ;;2:TO UNAUTHORIZED ABSENCE
|
|---|
| 35 | ;;3:TO ASIH
|
|---|
| 36 | ;;4:FROM AUTHORIZED ABSENCE
|
|---|
| 37 | ;;5:FROM UNAUTHORIZED ABSENCE
|
|---|
| 38 | ;;6:FROM ASIH < 15 DAYS
|
|---|
