- 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 Mar 13, 2025@21:05:02 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
