| 1 | FBAAVR0 ;AISC/GRR-REJECT ITEMS ;01JAN86
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | STUFF S FBRFLAG=1,$P(^FBAAC(J,1,K,1,L,1,M,"FBREJ"),"^",3)=$P(^FBAAC(J,1,K,1,L,1,M,0),"^",8),FBIN=$P(^(0),"^",16),$P(^(0),"^",8)="",$P(^("FBREJ"),"^",1)="P",$P(^("FBREJ"),"^",2)=FBRR,FBAAAP=+$P(^(0),"^",3),FBAARA=FBAARA+FBAAAP
|
|---|
| 5 | K ^FBAAC("AC",B,J,K,L,M),^FBAAC("AJ",B,FBIN,J,K,L,M),QQ(HX) S ^FBAAC("AH",B,J,K,L,M)="",$P(FZ,"^",9)=($P(FZ,"^",9)-FBAAAP),$P(FZ,"^",11)=($P(FZ,"^",11)-1),$P(FZ,"^",17)="Y"
|
|---|
| 6 | S $P(^FBAA(161.7,B,0),"^",9)=$P(FZ,"^",9),$P(^(0),"^",11)=$P(FZ,"^",11),$P(^(0),"^",17)="Y"
|
|---|
| 7 | Q
|
|---|
| 8 | VCHNH F J=0:0 S J=$O(^FBAAI("AC",B,J)) Q:J'>0 I '$D(^FBAAI(J,"FBREJ")),$D(^FBAAI(J,0)) S DA=J,(DIE,DIC)="^FBAAI(",DIC(0)="LQ",DR="19////^S X=DT",DLAYGO=162.5 D ^DIE
|
|---|
| 9 | K DIE,DIC,DA,DLAYGO Q
|
|---|
| 10 | ERR S FBST=^FBAA(161.7,FBN,"ST")
|
|---|
| 11 | I FBST="O" W !,*7,"Batch is still Open!" G BT^FBAAVR
|
|---|
| 12 | I FBST="C" W !,*7,"Supervisor has not Released Batch yet!" G BT^FBAAVR
|
|---|
| 13 | I FBST="S" W !,*7,"Batch has not been Transmitted yet!" G BT^FBAAVR
|
|---|
| 14 | DELC K QQ W !! S DIC=161,DIC("A")="Select Patient: ",DIC(0)="AEMZ",DIC("S")="I $D(^FBAAI(""AE"",B,+Y))" D ^DIC Q:X=""!($D(DTOUT))!($D(DUOUT)) G DELC:Y<0 S FBDFN=+Y K DIC
|
|---|
| 15 | ;I $D(^FBAAI(FBI,"FBREJ")) W !!,*7,"Payment already rejected!",! G DELC
|
|---|
| 16 | S (QQ,FBAAOUT)=0 W @IOF D HEDC^FBAACCB1 F I=0:0 S I=$O(^FBAAI("AE",B,FBDFN,I)) Q:I'>0!(FBAAOUT) I $D(^FBAAI(I,0)) S Z(0)=^(0),FBI=I D WRITC
|
|---|
| 17 | RL S DIR(0)="Y",DIR("A")="Want all line items rejected for this patient",DIR("B")="YES" D ^DIR K DIR G DELC:$D(DIRUT),LOOP:Y
|
|---|
| 18 | RL1 S DIR(0)="NO^1:"_QQ,DIR("A")="Reject which line item" D ^DIR K DIR G DELC:X=""!$D(DIRUT) S HX=X
|
|---|
| 19 | I '$D(QQ(HX)) W !,*7,"You already rejected that one!!" G RL1
|
|---|
| 20 | RJT S DIR(0)="Y",DIR("A")="Are you sure you want to reject item number: "_HX,DIR("B")="NO" D ^DIR K DIR G RL1:$D(DIRUT)!'Y
|
|---|
| 21 | RDR1 S DIR(0)="F^2:40",DIR("A")="Enter reason for rejecting" D ^DIR K DIR W:$D(DIRUT) !!,"Required Response!!" G:$D(DIRUT) RDR1 S FBRR=X
|
|---|
| 22 | S I=QQ(HX) D RESET
|
|---|
| 23 | RDMORE S DIR(0)="Y",DIR("A")="Item rejected. Want to reject another",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT) G RL1:Y
|
|---|
| 24 | Q
|
|---|
| 25 | WRITC S QQ=QQ+1,QQ(QQ)=I D CMORE^FBAACCB1 Q
|
|---|
| 26 | LOOP S DIR(0)="F^2:40",DIR("A")="Reason for rejecting" D ^DIR K DIR W:$D(DIRUT) !!,"Required Response!!" G:$D(DIRUT) LOOP S FBRR=X
|
|---|
| 27 | F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0 S I=QQ(HX) D RESET
|
|---|
| 28 | W !,"...DONE!" G DELC
|
|---|
| 29 | RESET K DR S (DIC,DIE)="^FBAAI(",DA=I,DR="20///^S X=""@"";13////^S X=""P"";14////^S X=FBRR;15////^S X=B" D ^DIE K DIC,DIE
|
|---|
| 30 | S FBAAAP=+$P(^FBAAI(I,0),"^",9),FBMM=$E($P(^(0),U,6),4,5),$P(FZ,"^",9)=$P(FZ,"^",9)-FBAAAP,$P(FZ,"^",10)=$P(FZ,"^",10)-1,$P(FZ,"^",11)=$P(FZ,"^",11)-1,$P(FZ,"^",17)="Y",^FBAA(161.7,B,0)=FZ,FBAARA=FBAARA+FBAAAP K QQ(HX)
|
|---|
| 31 | S FBAAMT=-FBAAAP,FBII78=$P(^FBAAI(I,0),"^",5) D INPOST^FBAARD3
|
|---|
| 32 | Q
|
|---|
