| [613] | 1 | FBAAVR2 ;AISC/GRR-FINALIZE BATCH ;01JAN86
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | GET W !! S DIC="^FBAAA(",DIC(0)="AEQM" D ^DIC Q:X="^"!(X="") G GET:Y<0 S DA=+Y,J=DA Q
|
|---|
| 5 | DELM K QQ D GET Q:X="^"!(X="") I '$D(^FBAAC("AC",B,J)) W !!,*7,"No payments in this batch for that patient!" G DELM
|
|---|
| 6 | S (QQ,FBAAOUT)=0 W @IOF D HED^FBAACCB
|
|---|
| 7 | F K=0:0 S K=$O(^FBAAC("AC",B,J,K)) Q:K'>0!(FBAAOUT) F L=0:0 S L=$O(^FBAAC("AC",B,J,K,L)) Q:L'>0!(FBAAOUT) F M=0:0 S M=$O(^FBAAC("AC",B,J,K,L,M)) Q:M'>0!(FBAAOUT) D WRITM
|
|---|
| 8 | RL1 S DIR(0)="Y",DIR("A")="Want all line items rejected for this patient",DIR("B")="YES" D ^DIR K DIR G DELM:$D(DIRUT),LOOP:Y
|
|---|
| 9 | RL S DIR(0)="N^1:"_QQ,DIR("A")="Reject which line item" D ^DIR K DIR G DELM:X=""!$D(DIRUT) S HX=X
|
|---|
| 10 | I '$D(QQ(HX)) W !,*7,"You already rejected that one!!" G RL
|
|---|
| 11 | 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 RL:$D(DIRUT)!'Y
|
|---|
| 12 | S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2),L=$P(QQ(HX),"^",3),M=$P(QQ(HX),"^",4)
|
|---|
| 13 | 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
|
|---|
| 14 | D ^FBAAVR0
|
|---|
| 15 | RDMORE S DIR(0)="Y",DIR("A")="Item rejected. Want to reject another",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT) G RL:Y,DELM
|
|---|
| 16 | WRITM S QQ=QQ+1,QQ(QQ)=J_"^"_K_"^"_L_"^"_M D SET^FBAACCB Q
|
|---|
| 17 | 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
|
|---|
| 18 | F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0 S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2),L=$P(QQ(HX),"^",3),M=$P(QQ(HX),"^",4) D ^FBAAVR0
|
|---|
| 19 | W !,"...DONE!" G DELM
|
|---|
| 20 | Q Q
|
|---|
