| [613] | 1 | FBUCDUP ;ALBISC/TET - Duplicate check of claims ;4/28/93 11:14
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | BUILD ;build display array of potential duplicates
|
|---|
| 5 | ;INPUT: FBVET - ien of veteran
|
|---|
| 6 | ; FBVEN - ien of vendor
|
|---|
| 7 | ; FBTFROM - from treatment date of claim
|
|---|
| 8 | ; FBTTO - to treatment date of claim
|
|---|
| 9 | ;OUTPUT: FBDISP( - array of claims within same date range
|
|---|
| 10 | N DTOUT,DUOUT
|
|---|
| 11 | G:'$D(^FB583("APF",FBVET)) END N FBFROM,FBDA,NODE S FBFROM=FBTFROM-.1 ;S FBFROM=$$CDTC^FBUCUTL(FBTFROM,-730),FBFROM=FBFROM-.1
|
|---|
| 12 | F S FBFROM=$O(^FB583("APF",FBVET,FBFROM)) Q:'FBFROM!(FBFROM>FBTFROM) D
|
|---|
| 13 | .S FBDA=0 F S FBDA=$O(^FB583("APF",FBVET,FBFROM,FBDA)) Q:'FBDA S NODE=$G(^FB583(FBDA,0)) I $P(NODE,U,6)=FBTTO,$P(NODE,U,3)=FBVEN S FBDISP(FBDA)=NODE
|
|---|
| 14 | .;S FBDA=0 F S FBDA=$O(^FB583("APF",FBVET,FBFROM,FBDA)) Q:'FBDA S:'$O(FBDISP(FBDA)) FBDISP(FBDA)=$G(^FB583(FBDA,0))
|
|---|
| 15 | ;Q
|
|---|
| 16 | LIST ;display array of potential duplicates
|
|---|
| 17 | ;INPUT: FBDISP( - array of claims within same date range of submitted
|
|---|
| 18 | ;OUTPUT: formatted display of list; FBOUT for uparrow or timeout
|
|---|
| 19 | G:'$D(FBDISP) END N FBPG,FBCRT,FBTITLE,FBDASH,FBDA,FBZ,FBOUT
|
|---|
| 20 | S FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBTITLE="POTENTIAL DUPLICATES",$P(FBDASH,"=",80)="",FBOUT=0
|
|---|
| 21 | D HDR S FBDA=0 F S FBDA=$O(FBDISP(FBDA)) G:'FBDA END D
|
|---|
| 22 | .D:($Y+3)>IOSL PAGE Q:FBOUT S FBZ=FBDISP(FBDA)
|
|---|
| 23 | .W !,FBDA,?10,$E($$VET^FBUCUTL($P(FBZ,U,4)),1,25),?40,$E($$VEN^FBUCUTL($P(FBZ,U,3)),1,25),?70,$E($$PROG^FBUCUTL($P(FBZ,U,2)),1,10)
|
|---|
| 24 | .W !?5,"TREATMENT FROM: ",$$DATX^FBAAUTL($P(FBZ,U,5)),?40,"TREATMENT TO: ",$$DATX^FBAAUTL($P(FBZ,U,6))
|
|---|
| 25 | ;
|
|---|
| 26 | END Q
|
|---|
| 27 | HDR ;header of list display
|
|---|
| 28 | I FBPG>0!FBCRT W @IOF
|
|---|
| 29 | S FBPG=FBPG+1
|
|---|
| 30 | W !?(IOM-$L(FBTITLE)/2),FBTITLE
|
|---|
| 31 | W !,"No.",?10,"VETERAN",?40,"VENDOR",?70,"PROGRAM",!
|
|---|
| 32 | Q
|
|---|
| 33 | CR ;carriage return
|
|---|
| 34 | S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
|
|---|
| 35 | Q
|
|---|
| 36 | PAGE ;new page
|
|---|
| 37 | I FBCRT D CR I 'FBOUT D HDR
|
|---|
| 38 | Q
|
|---|
