source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAVR2.m@ 792

Last change on this file since 792 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1FBAAVR2 ;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.
4GET W !! S DIC="^FBAAA(",DIC(0)="AEQM" D ^DIC Q:X="^"!(X="") G GET:Y<0 S DA=+Y,J=DA Q
5DELM 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
8RL1 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
9RL 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
11RJT 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)
13RDR1 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
15RDMORE 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
16WRITM S QQ=QQ+1,QQ(QQ)=J_"^"_K_"^"_L_"^"_M D SET^FBAACCB Q
17LOOP 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
20Q Q
Note: See TracBrowser for help on using the repository browser.