source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCHRR.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1FBCHRR ;AISC/DMK-RE-INITIATE REJECTS FROM PRICER ;7/17/2003
2 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4DIC S FBTYPE="B9"
5 W ! S DIC="^FBAA(161.7,",DIC(0)="AEQMZ",DIC("S")="I $P(^(0),U,15)=""Y""&($P(^(0),U,17)]"""")"_$S($D(^XUSEC("FBAASUPERVISOR",DUZ)):"",1:"&($P(^(0),U,5)=DUZ)"),DIC("A")="Select Batch with Pricer Rejects: " D ^DIC
6 G END:X="^"!(X=""),DIC:Y<0 S FBN=+Y,FBN(0)=Y(0)
7 I '$D(^FBAAI("AH",FBN)) W !!,*7,"No items rejected for this batch!",! G DIC
8DIC1 W !! S DIC="^FBAA(161.7,",DIC(0)="AEQMZ",DIC("A")="Select New Batch Number: ",DIC("S")="I $P(^(0),U,3)=FBTYPE&($P(^(0),U,5)=DUZ)&($P(^(0),U,15)=""Y"")&($G(^(""ST""))=""O"")&($P(^(0),U,18)'[""Y"")"
9 D ^DIC K DIC G DIC:$E(X)="^"!(X=""),DIC1:Y<0 S FBNB=+Y,FBNB(0)=Y(0)
10DIC2 W ! S DIC="^FBAAI(",DIC(0)="AEQMZ",DIC("A")="Select Patient: ",D="D",DIC("S")="I $D(^(""FBREJ"")),$P(^(""FBREJ""),U,3)=FBN" D IX^DIC G DIC:$E(X)="^"!(X=""),DIC2:Y<0 S FBI=+Y,FBI(0)=Y(0) G END:'$D(^FBAAI(FBI,0))
11 S FBLISTC="" D HOME^%ZIS,START^FBCHDI2
12ASK S DIR(0)="Y",DIR("A")="Want to re-initiate this payment",DIR("B")="NO" D ^DIR K DIR G END:$D(DIRUT),DIC:'Y
13 S (DIC,DIE)="^FBAAI(",DIC(0)="AEQM",DA=FBI,DR="20////^S X=FBNB" D ^DIE
14 K ^FBAAI(FBI,"FBREJ"),^FBAAI("AH",FBN,FBI) S $P(FBNB(0),"^",10)=$P(FBNB(0),"^",10)+1,$P(FBNB(0),"^",11)=$P(FBNB(0),"^",11)+1,$P(FBNB(0),"^",18)="N",^FBAA(161.7,FBNB,0)=FBNB(0)
15 I '$D(^FBAAI("AH",FBN)) S $P(FBN(0),"^",17)="",^FBAA(161.7,FBN,0)=FBN(0)
16 I $D(^FBAAI("AH",FBN)) G DIC2
17EDIT S DIR(0)="Y",DIR("A")="Want to edit payment now",DIR("B")="YES" D ^DIR K DIR G END:$D(DIRUT)!'Y
18 S FBPRICE=""
19 ; get values of FPPS Claim ID and Line Item
20 S FBFPPSC=$P($G(^FBAAI(FBI,3)),U)
21 S FBFPPSL=$P($G(^FBAAI(FBI,3)),U,2)
22 ; load current adjustment data
23 D LOADADJ^FBCHFA(FBI_",",.FBADJ)
24 ; save adjustment data prior to edit session in sorted list
25 S FBADJL(0)=$$ADJL^FBUTL2(.FBADJ) ; sorted list of original adjustments
26 ; load current remittance remark data
27 D LOADRR^FBCHFR(FBI_",",.FBRRMK)
28 ; save remittance remarks prior to edit session in sorted list
29 S FBRRMKL(0)=$$RRL^FBUTL4(.FBRRMK)
30 S (DIC,DIE)="^FBAAI(",DA=FBI,DR="[FBCH EDIT PAYMENT]"
31 D ^DIE G H^XUS:$D(DTOUT)
32 ; if adjustment data changed then file
33 I $$ADJL^FBUTL2(.FBADJ)'=FBADJL(0) D FILEADJ^FBCHFA(FBI_",",.FBADJ)
34 ; if remit remark data changed then file
35 I $$RRL^FBUTL4(.FBRRMK)'=FBRRMKL(0) D FILERR^FBCHFR(FBI_",",.FBRRMK)
36END K DIC,D,DA,DIRUT,DR,DTOUT,DUOUT,FBPRICE,VAL,DIE,FBI,FBN,FBNB,FBTYPE,I,POP,X,Y,FBLISTC
37 K FBFPPSC,FBFPPSL,FBADJ,FBADJL,FBRRMK,FBRRMKL
38 D END^FBCHDI
39 Q
Note: See TracBrowser for help on using the repository browser.