FBUCLET0 ;ALBISC/TET - UNAUTHORIZED CLAIM LETTER DQ (CONT.) ;12/3/2001
;;3.5;FEE BASIS;**32,38**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
BATCHDQ ;tasked entry point from batch^fbuclet or option
U IO S FBFF=0 S:'$D(FBUC) FBUC=$$FBUC^FBUCUTL2(1) S:'$D(FBCOPIES) FBCOPIES=$S($P(FBUC,U,4):$P(FBUC,U,4),1:1) D STANUM^FBUCUTL2 D:'$P($G(FBUC),U,8) STATADD^FBUCUTL2
D DISPNP^FBUCUTL3 ;set array of letters which are waiting to be printed
S FBAR=$G(^TMP("FBAR",$J,"FBAR")) I +FBAR D
.N FBDA,FBEXP,FBI,FBORDER,FBP,FBPL,FBW S FBI=0 D PARSE^FBUCUTL4(FBAR)
.F S FBI=$O(^TMP("FBAR",$J,FBI)) Q:'FBI D
..S FBDA=+$P($G(^TMP("FBAR",$J,FBI)),";")
..S FBUCA=$G(^FB583(FBDA,0))
..S FBORDER=$$ORDER^FBUCUTL(+$P(FBUCA,U,24))
..; if only one type of letter was requested for a batch print then
..; skip the claim if it's letter is not of that type
..I $G(FBLTRTYP),FBLTRTYP'=$$LETTER^FBUCUTL2(FBORDER,+$P(FBUCA,U,28)) Q
..; if disposition letter, approved or approved to stabilization then
..; skip if no payments on file or not all payments have been released
..I FBORDER>20,"^1^4^"[(U_$P(FBUCA,U,11)_U),'$$PAYST^FBUCUTL(FBDA) Q
..D PRINT^FBUCLET1
K ^TMP("FBAR",$J) G END
REPRNTDQ ;tasked entry point from reprint^fbuclet
;fbnoup=1 if no update of expiration date, = 0 to update
U IO S FBFF=0 D STANUM^FBUCUTL2 D:'$P($G(FBUC),U,8) STATADD^FBUCUTL2 I 'FBNOUP K FBNOUP
D ARRAY:FBRANGE,STRING:'FBRANGE
N FBI S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI D
.S FBDA=+$P($G(^TMP("FBARY",$J,FBI)),";")
.S FBUCA=$G(^FB583(FBDA,0))
.S FBORDER=$$ORDER^FBUCUTL(+$P(FBUCA,U,24))
.; if only one type of letter was requested for a batch reprint then
.; skip the claim if it's letter is not of that type
.I $G(FBLTRTYP),FBLTRTYP'=$$LETTER^FBUCUTL2(FBORDER,+$P(FBUCA,U,28)) Q
.D PRINT^FBUCLET1
K ^TMP("FBARY",$J) G END
AUTODQ ;tasked entry point from auto^fbuclet
U IO S FBFF=0 S:'$D(FBUC) FBUC=$$FBUC^FBUCUTL2(1) D STANUM^FBUCUTL2 D:'$P(FBUC,U,8) STATADD^FBUCUTL2 D PRINT^FBUCLET1
;G END
END S ZTREQ="@" D ^%ZISC K ZTRTN,ZTSTOP,ZTIO,ZTDESC,FBADD,FBAR,FBARY,FBCOPIES,FBDA,FBFF,FBFR,FBNOUP,FBORDER,FBSADD,FBSTANUM,FBTO,FBUCA,FBUC,XRT0,XRTN,FBLTRTYP
Q
STRING ;process string of ien's if not date range/called by reprntdq
;INPUT: FBARY( array of ien of selected unauthorized claims
;OUTPUT: TMP(FBARY,$J array
N FBDCT,FBA S (FBDCT,FBA)=0 F S FBA=$O(FBARY(FBA)) Q:'FBA D
.N FBCT,FBI,FBDA S FBCT=($L(FBARY(FBA),",")) F FBI=1:1:FBCT S FBDCT=FBDCT+1,FBDA=$P(FBARY(FBA),",",FBI),^TMP("FBARY",$J,FBDCT)=+FBDA
Q
ARRAY ;set array in tmp for date range
;called by reprntdq if date range selected
;INPUT VARIABLES: FBFR = from date; FBTO = to date
N FBARY,FBDCT,FBDT,FBI,FBO,FBORDER,FBZ
S (FBDCT,FBORDER)=0,FBO="" F S FBORDER=$O(^FB(162.92,"AO",FBORDER)) Q:'FBORDER I $$LETTER^FBUCUTL2(FBORDER) S FBO=FBO_U_FBORDER
I FBO]"" S FBO=FBO_U
S FBDT=FBFR F S FBDT=$O(^FB583("ALP",FBDT)) Q:'FBDT!(FBDT>FBTO) S FBI=0 F S FBI=$O(^FB583("ALP",FBDT,FBI)) Q:'FBI S FBZ=$G(^FB583(FBI,0)) I FBZ]"",FBO["^"_$$ORDER^FBUCUTL($P(FBZ,U,24))_"^" D
.N FBARY S FBDCT=FBDCT+1
.S FBARY=FBI_";"_$E($$VET^FBUCUTL($P(FBZ,U,4)),1,12)_U_$E($$VEN^FBUCUTL($P(FBZ,U,3)),1,12)_U_$E($$PROG^FBUCUTL($P(FBZ,U,2)),1,14)_U_$$DATX^FBAAUTL($P(FBZ,U))_U_$E($$PTR^FBUCUTL("^FB(162.92,",+$P(FBZ,U,24)),1,16)
.S ^TMP("FBARY",$J,FBDCT)=FBARY
S FBARY=FBDCT I FBDCT S FBARY=FBARY_";"_"5^20^35^52^63^",^TMP("FBARY",$J,"FBARY")=FBARY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCLET0 3497 printed Nov 22, 2024@17:10:26 Page 2
FBUCLET0 ;ALBISC/TET - UNAUTHORIZED CLAIM LETTER DQ (CONT.) ;12/3/2001
+1 ;;3.5;FEE BASIS;**32,38**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
BATCHDQ ;tasked entry point from batch^fbuclet or option
+1 USE IO
SET FBFF=0
if '$DATA(FBUC)
SET FBUC=$$FBUC^FBUCUTL2(1)
if '$DATA(FBCOPIES)
SET FBCOPIES=$SELECT($PIECE(FBUC,U,4):$PIECE(FBUC,U,4),1:1)
DO STANUM^FBUCUTL2
if '$PIECE($GET(FBUC),U,8)
DO STATADD^FBUCUTL2
+2 ;set array of letters which are waiting to be printed
DO DISPNP^FBUCUTL3
+3 SET FBAR=$GET(^TMP("FBAR",$JOB,"FBAR"))
IF +FBAR
Begin DoDot:1
+4 NEW FBDA,FBEXP,FBI,FBORDER,FBP,FBPL,FBW
SET FBI=0
DO PARSE^FBUCUTL4(FBAR)
+5 FOR
SET FBI=$ORDER(^TMP("FBAR",$JOB,FBI))
if 'FBI
QUIT
Begin DoDot:2
+6 SET FBDA=+$PIECE($GET(^TMP("FBAR",$JOB,FBI)),";")
+7 SET FBUCA=$GET(^FB583(FBDA,0))
+8 SET FBORDER=$$ORDER^FBUCUTL(+$PIECE(FBUCA,U,24))
+9 ; if only one type of letter was requested for a batch print then
+10 ; skip the claim if it's letter is not of that type
+11 IF $GET(FBLTRTYP)
IF FBLTRTYP'=$$LETTER^FBUCUTL2(FBORDER,+$PIECE(FBUCA,U,28))
QUIT
+12 ; if disposition letter, approved or approved to stabilization then
+13 ; skip if no payments on file or not all payments have been released
+14 IF FBORDER>20
IF "^1^4^"[(U_$PIECE(FBUCA,U,11)_U)
IF '$$PAYST^FBUCUTL(FBDA)
QUIT
+15 DO PRINT^FBUCLET1
End DoDot:2
End DoDot:1
+16 KILL ^TMP("FBAR",$JOB)
GOTO END
REPRNTDQ ;tasked entry point from reprint^fbuclet
+1 ;fbnoup=1 if no update of expiration date, = 0 to update
+2 USE IO
SET FBFF=0
DO STANUM^FBUCUTL2
if '$PIECE($GET(FBUC),U,8)
DO STATADD^FBUCUTL2
IF 'FBNOUP
KILL FBNOUP
+3 if FBRANGE
DO ARRAY
if 'FBRANGE
DO STRING
+4 NEW FBI
SET FBI=0
FOR
SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
if 'FBI
QUIT
Begin DoDot:1
+5 SET FBDA=+$PIECE($GET(^TMP("FBARY",$JOB,FBI)),";")
+6 SET FBUCA=$GET(^FB583(FBDA,0))
+7 SET FBORDER=$$ORDER^FBUCUTL(+$PIECE(FBUCA,U,24))
+8 ; if only one type of letter was requested for a batch reprint then
+9 ; skip the claim if it's letter is not of that type
+10 IF $GET(FBLTRTYP)
IF FBLTRTYP'=$$LETTER^FBUCUTL2(FBORDER,+$PIECE(FBUCA,U,28))
QUIT
+11 DO PRINT^FBUCLET1
End DoDot:1
+12 KILL ^TMP("FBARY",$JOB)
GOTO END
AUTODQ ;tasked entry point from auto^fbuclet
+1 USE IO
SET FBFF=0
if '$DATA(FBUC)
SET FBUC=$$FBUC^FBUCUTL2(1)
DO STANUM^FBUCUTL2
if '$PIECE(FBUC,U,8)
DO STATADD^FBUCUTL2
DO PRINT^FBUCLET1
+2 ;G END
END SET ZTREQ="@"
DO ^%ZISC
KILL ZTRTN,ZTSTOP,ZTIO,ZTDESC,FBADD,FBAR,FBARY,FBCOPIES,FBDA,FBFF,FBFR,FBNOUP,FBORDER,FBSADD,FBSTANUM,FBTO,FBUCA,FBUC,XRT0,XRTN,FBLTRTYP
+1 QUIT
STRING ;process string of ien's if not date range/called by reprntdq
+1 ;INPUT: FBARY( array of ien of selected unauthorized claims
+2 ;OUTPUT: TMP(FBARY,$J array
+3 NEW FBDCT,FBA
SET (FBDCT,FBA)=0
FOR
SET FBA=$ORDER(FBARY(FBA))
if 'FBA
QUIT
Begin DoDot:1
+4 NEW FBCT,FBI,FBDA
SET FBCT=($LENGTH(FBARY(FBA),","))
FOR FBI=1:1:FBCT
SET FBDCT=FBDCT+1
SET FBDA=$PIECE(FBARY(FBA),",",FBI)
SET ^TMP("FBARY",$JOB,FBDCT)=+FBDA
End DoDot:1
+5 QUIT
ARRAY ;set array in tmp for date range
+1 ;called by reprntdq if date range selected
+2 ;INPUT VARIABLES: FBFR = from date; FBTO = to date
+3 NEW FBARY,FBDCT,FBDT,FBI,FBO,FBORDER,FBZ
+4 SET (FBDCT,FBORDER)=0
SET FBO=""
FOR
SET FBORDER=$ORDER(^FB(162.92,"AO",FBORDER))
if 'FBORDER
QUIT
IF $$LETTER^FBUCUTL2(FBORDER)
SET FBO=FBO_U_FBORDER
+5 IF FBO]""
SET FBO=FBO_U
+6 SET FBDT=FBFR
FOR
SET FBDT=$ORDER(^FB583("ALP",FBDT))
if 'FBDT!(FBDT>FBTO)
QUIT
SET FBI=0
FOR
SET FBI=$ORDER(^FB583("ALP",FBDT,FBI))
if 'FBI
QUIT
SET FBZ=$GET(^FB583(FBI,0))
IF FBZ]""
IF FBO["^"_$$ORDER^FBUCUTL($PIECE(FBZ,U,24))_"^"
Begin DoDot:1
+7 NEW FBARY
SET FBDCT=FBDCT+1
+8 SET FBARY=FBI_";"_$EXTRACT($$VET^FBUCUTL($PIECE(FBZ,U,4)),1,12)_U_$EXTRACT($$VEN^FBUCUTL($PIECE(FBZ,U,3)),1,12)_U_$EXTRACT($$PROG^FBUCUTL($PIECE(FBZ,U,2)),1,14)_U_$$DATX^FBAAUTL($PIECE(FBZ,U))_U_$EXTRACT($$PTR^FBUCUTL("^FB(16
2.92,",+...
... $PIECE(FBZ,U,24)),1,16)
+9 SET ^TMP("FBARY",$JOB,FBDCT)=FBARY
End DoDot:1
+10 SET FBARY=FBDCT
IF FBDCT
SET FBARY=FBARY_";"_"5^20^35^52^63^"
SET ^TMP("FBARY",$JOB,"FBARY")=FBARY
+11 QUIT
