FBUCDUP ;ALBISC/TET - Duplicate check of claims ;4/28/93 11:14
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
BUILD ;build display array of potential duplicates
;INPUT: FBVET - ien of veteran
; FBVEN - ien of vendor
; FBTFROM - from treatment date of claim
; FBTTO - to treatment date of claim
;OUTPUT: FBDISP( - array of claims within same date range
N DTOUT,DUOUT
G:'$D(^FB583("APF",FBVET)) END N FBFROM,FBDA,NODE S FBFROM=FBTFROM-.1 ;S FBFROM=$$CDTC^FBUCUTL(FBTFROM,-730),FBFROM=FBFROM-.1
F S FBFROM=$O(^FB583("APF",FBVET,FBFROM)) Q:'FBFROM!(FBFROM>FBTFROM) D
.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
.;S FBDA=0 F S FBDA=$O(^FB583("APF",FBVET,FBFROM,FBDA)) Q:'FBDA S:'$O(FBDISP(FBDA)) FBDISP(FBDA)=$G(^FB583(FBDA,0))
;Q
LIST ;display array of potential duplicates
;INPUT: FBDISP( - array of claims within same date range of submitted
;OUTPUT: formatted display of list; FBOUT for uparrow or timeout
G:'$D(FBDISP) END N FBPG,FBCRT,FBTITLE,FBDASH,FBDA,FBZ,FBOUT
S FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBTITLE="POTENTIAL DUPLICATES",$P(FBDASH,"=",80)="",FBOUT=0
D HDR S FBDA=0 F S FBDA=$O(FBDISP(FBDA)) G:'FBDA END D
.D:($Y+3)>IOSL PAGE Q:FBOUT S FBZ=FBDISP(FBDA)
.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)
.W !?5,"TREATMENT FROM: ",$$DATX^FBAAUTL($P(FBZ,U,5)),?40,"TREATMENT TO: ",$$DATX^FBAAUTL($P(FBZ,U,6))
;
END Q
HDR ;header of list display
I FBPG>0!FBCRT W @IOF
S FBPG=FBPG+1
W !?(IOM-$L(FBTITLE)/2),FBTITLE
W !,"No.",?10,"VETERAN",?40,"VENDOR",?70,"PROGRAM",!
Q
CR ;carriage return
S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
Q
PAGE ;new page
I FBCRT D CR I 'FBOUT D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCDUP 1950 printed Dec 13, 2024@02:00:07 Page 2
FBUCDUP ;ALBISC/TET - Duplicate check of claims ;4/28/93 11:14
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
BUILD ;build display array of potential duplicates
+1 ;INPUT: FBVET - ien of veteran
+2 ; FBVEN - ien of vendor
+3 ; FBTFROM - from treatment date of claim
+4 ; FBTTO - to treatment date of claim
+5 ;OUTPUT: FBDISP( - array of claims within same date range
+6 NEW DTOUT,DUOUT
+7 ;S FBFROM=$$CDTC^FBUCUTL(FBTFROM,-730),FBFROM=FBFROM-.1
if '$DATA(^FB583("APF",FBVET))
GOTO END
NEW FBFROM,FBDA,NODE
SET FBFROM=FBTFROM-.1
+8 FOR
SET FBFROM=$ORDER(^FB583("APF",FBVET,FBFROM))
if 'FBFROM!(FBFROM>FBTFROM)
QUIT
Begin DoDot:1
+9 SET FBDA=0
FOR
SET FBDA=$ORDER(^FB583("APF",FBVET,FBFROM,FBDA))
if 'FBDA
QUIT
SET NODE=$GET(^FB583(FBDA,0))
IF $PIECE(NODE,U,6)=FBTTO
IF $PIECE(NODE,U,3)=FBVEN
SET FBDISP(FBDA)=NODE
+10 ;S FBDA=0 F S FBDA=$O(^FB583("APF",FBVET,FBFROM,FBDA)) Q:'FBDA S:'$O(FBDISP(FBDA)) FBDISP(FBDA)=$G(^FB583(FBDA,0))
End DoDot:1
+11 ;Q
LIST ;display array of potential duplicates
+1 ;INPUT: FBDISP( - array of claims within same date range of submitted
+2 ;OUTPUT: formatted display of list; FBOUT for uparrow or timeout
+3 if '$DATA(FBDISP)
GOTO END
NEW FBPG,FBCRT,FBTITLE,FBDASH,FBDA,FBZ,FBOUT
+4 SET FBPG=0
SET FBCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
SET FBTITLE="POTENTIAL DUPLICATES"
SET $PIECE(FBDASH,"=",80)=""
SET FBOUT=0
+5 DO HDR
SET FBDA=0
FOR
SET FBDA=$ORDER(FBDISP(FBDA))
if 'FBDA
GOTO END
Begin DoDot:1
+6 if ($Y+3)>IOSL
DO PAGE
if FBOUT
QUIT
SET FBZ=FBDISP(FBDA)
+7 WRITE !,FBDA,?10,$EXTRACT($$VET^FBUCUTL($PIECE(FBZ,U,4)),1,25),?40,$EXTRACT($$VEN^FBUCUTL($PIECE(FBZ,U,3)),1,25),?70,$EXTRACT($$PROG^FBUCUTL($PIECE(FBZ,U,2)),1,10)
+8 WRITE !?5,"TREATMENT FROM: ",$$DATX^FBAAUTL($PIECE(FBZ,U,5)),?40,"TREATMENT TO: ",$$DATX^FBAAUTL($PIECE(FBZ,U,6))
End DoDot:1
+9 ;
END QUIT
HDR ;header of list display
+1 IF FBPG>0!FBCRT
WRITE @IOF
+2 SET FBPG=FBPG+1
+3 WRITE !?(IOM-$LENGTH(FBTITLE)/2),FBTITLE
+4 WRITE !,"No.",?10,"VETERAN",?40,"VENDOR",?70,"PROGRAM",!
+5 QUIT
CR ;carriage return
+1 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET FBOUT=1
+2 QUIT
PAGE ;new page
+1 IF FBCRT
DO CR
IF 'FBOUT
DO HDR
+2 QUIT
