| 1 | FBCHCD ;AISC/DMK-COMPLETE DISPOSITION ;23JAN88
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ASK S DIC="^FB7078(",DIC(0)="AEQMZ",D="D",DIC("A")="Select Veteran: ",DIC("S")="I $P(^(0),U,9)=""I""" D IX^DIC G END:$E(X)="^"!(X=""),ASK:Y<0 S (DA,FBAA78)=+Y,FBTYPE=6,FB(0)=Y(0),FBDXS="",FBFRDT=$P(FB(0),"^",4) K DIC("S"),D
|
|---|
| 5 | EN S DIR(0)="162.4,4",DIR("A")="AUTHORIZATION TO DATE" D ^DIR
|
|---|
| 6 | G END:$D(DUOUT),END:+Y'>0,H^XUS:$D(DTOUT) S FBTODT=+Y K DIR,X,Y
|
|---|
| 7 | I FBTODT]"",FBFRDT>FBTODT W !!,*7,?5,"Authorization To Date must be after Authorization From Date!",! G EN
|
|---|
| 8 | S DIR(0)="162.4,4.5",DIR("A")="DATE OF DISCHARGE" D ^DIR K DIR
|
|---|
| 9 | G END:$D(DUOUT),END:+Y'>0,H^XUS:$D(DTOUT) S FBDOD=+Y K X,Y
|
|---|
| 10 | I FBDOD]"",FBTODT>FBDOD W !!,*7,?5,"Date of Discharge must not be earlier than the Authorization To Date!",! G EN
|
|---|
| 11 | S FBVEN=$P(FB(0),"^",2),FBVET=$P(FB(0),"^",3),DIE=DIC,DR="4////^S X=FBTODT;S:X="""" (Y,FBTODT)="""";S FBTODT=X;4.5////^S X=FBDOD" D ^DIE G END:FBTODT=""
|
|---|
| 12 | ASKPT W ! S DIR(0)="SAO^00:SURGICAL;10:MEDICAL;86:PSYCHIATRY",DIR("A")="BEDSECTION/TREATING: ",DIR("?")="^D HELP^FBCH780" D ^DIR D NOUP:$D(DIRUT) G ASKPT:$D(DIRUT) S FBPT=Y K X,Y,DIRUT,DIR G AUTH^FBCH78
|
|---|
| 13 | EDIT ;ENTRY TO EDIT A COMPLETED DISPOSITION
|
|---|
| 14 | S FBEDAT=0
|
|---|
| 15 | S DIC="^FB7078(",DIC(0)="AEMQZ",D="D",DIC("A")="Select Patient: ",DIC("S")="I $P(^(0),U,9)=""C""&($P(^(0),U,11)=6)" D IX^DIC G END:X="^"!(X=""),EDIT:Y<0 S FB7078=+Y,FBVET=$P(Y(0),"^",3),FBHTDT=$P(Y(0),"^",5),FBHFDT=$P(Y(0),"^",4)
|
|---|
| 16 | G END:'$D(^FBAAA("AG",FB7078_";FB7078("))
|
|---|
| 17 | I $D(^FBAAI("E",FB7078_";FB7078(")) S FBEDAT=1 W !!,*7,"Payment already exists for this disposition, editing of dates not allowed!",!
|
|---|
| 18 | I 'FBEDAT S DA=$O(^FBAA(162.2,"AM",+FB7078,0)) I DA]"" S DIE="^FBAA(162.2,",DR="4;S FBFRDT=(X\1)",DIE("NO^")="" D ^DIE K DIE,DR
|
|---|
| 19 | I 'FBEDAT,(DA']"") G END
|
|---|
| 20 | I 'FBEDAT,$G(FBFRDT) S DIE="^FB7078(",DA=+FB7078,DR=$S(FBHFDT'=FBFRDT:"3///^S X=FBFRDT;I 1;",1:"")_"4;S FBTODT=X",DIE("NO^")="" D ^DIE K DIE,DR
|
|---|
| 21 | G END:+$G(FBTODT)'>0,END:'$G(FBFRDT)
|
|---|
| 22 | I 'FBEDAT,(FBHTDT'=FBTODT),(FBTODT>$P(^FB7078(+FB7078,0),"^",16)) W !!,*7,"Date of Discharge must now be edited to be equal to or later than",!,"the Authorization To Date.",! S FBDR="4.5////^S X=FBTODT;I 1;"
|
|---|
| 23 | I 'FBEDAT S FBDR=$G(FBDR)_"4.5;"
|
|---|
| 24 | S FBTYPE=6,DIE="^FB7078(",DA=+FB7078,DR=$S($G(FBDR):FBDR,1:"")_"7///^S X=""@"";5ADMITTING AUTHORITY~",DIE("NO^")="" D ^DIE K DIC,DIE,D,DR,DA,FBDR
|
|---|
| 25 | S DA(1)=FBVET,DIC="^FBAAA("_FBVET_",1,",DIC(0)="EQM",DA=$O(^FBAAA("AG",FB7078_";FB7078(",FBVET,0))
|
|---|
| 26 | S DR=$S(FBEDAT'=1:".01////^S X=FBFRDT;",1:"")_$S(FBEDAT'=1:".02////^S X=FBTODT;",1:"")_".06;D DEFPTC^FBCHCD;.065///^S X=FBPT;.07;.021;.096;.097//^S X=""NO"""
|
|---|
| 27 | S DR(1,161.01,1)="I $D(^FBAAA(FBVET,1,DA,2,0)) S ^FB7078(FB7078,1,0)=^(0) F FBI=1:1 Q:'$D(^FBAAA(FBVET,1,DA,2,FBI,0)) I $D(^(0)) S ^FB7078(FB7078,1,FBI,0)=^(0);101",DIE=DIC,DIE("NO^")="" W ! D ^DIE K DIE,DR,DIC
|
|---|
| 28 | W !! G EDIT
|
|---|
| 29 | END K DIC,DIE,DA,DR,FB,FBPROG,FBAAOUT,FBSW,FBVET,FB7078,FBHTDT,FBTODT,FBTYPE,FBAA78,FBFRDT,FBVEN,K,PTYPE,X,Y,Z,FBDEF,FBPT,FBI,FBHFDT,J,FBZZ,FBDA,FBDFN,FBDXS,FBNAME,FBSSN,FBZZ,ZZZ,FBDOD,FBEDAT
|
|---|
| 30 | Q
|
|---|
| 31 | DEFPTC S FBDEF=$P(^FBAAA(FBVET,1,DA,0),U,18),FBDEF=$S(FBDEF="00":"SURGICAL",FBDEF=10:"MEDICAL",FBDEF=86:"PSYCHIATRY",1:"")
|
|---|
| 32 | N X,DP,Y,DQ S DIR(0)="SA^00:SURGICAL;10:MEDICAL;86:PSYCHIATRY",DIR("A")="BEDSECTION/TREATING SPECIALTY: ",DIR("?")="^D HELP^FBCH780",DIR("B")=FBDEF D ^DIR D NOUP:$D(DUOUT) G DEFPTC:$D(DIRUT) S FBPT=Y K DIR,DIRUT Q
|
|---|
| 33 | NOUP W !!,*7,?5,"This is a mandatory response. Entering an '^' is not allowed!",! D HELP^FBCH780 Q
|
|---|
