source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCLET0.m@ 1169

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

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1FBUCLET0 ;ALBISC/TET - UNAUTHORIZED CLAIM LETTER DQ (CONT.) ;12/3/2001
2 ;;3.5;FEE BASIS;**32,38**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4BATCHDQ ;tasked entry point from batch^fbuclet or option
5 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
6 D DISPNP^FBUCUTL3 ;set array of letters which are waiting to be printed
7 S FBAR=$G(^TMP("FBAR",$J,"FBAR")) I +FBAR D
8 .N FBDA,FBEXP,FBI,FBORDER,FBP,FBPL,FBW S FBI=0 D PARSE^FBUCUTL4(FBAR)
9 .F S FBI=$O(^TMP("FBAR",$J,FBI)) Q:'FBI D
10 ..S FBDA=+$P($G(^TMP("FBAR",$J,FBI)),";")
11 ..S FBUCA=$G(^FB583(FBDA,0))
12 ..S FBORDER=$$ORDER^FBUCUTL(+$P(FBUCA,U,24))
13 ..; if only one type of letter was requested for a batch print then
14 ..; skip the claim if it's letter is not of that type
15 ..I $G(FBLTRTYP),FBLTRTYP'=$$LETTER^FBUCUTL2(FBORDER,+$P(FBUCA,U,28)) Q
16 ..; if disposition letter, approved or approved to stabilization then
17 ..; skip if no payments on file or not all payments have been released
18 ..I FBORDER>20,"^1^4^"[(U_$P(FBUCA,U,11)_U),'$$PAYST^FBUCUTL(FBDA) Q
19 ..D PRINT^FBUCLET1
20 K ^TMP("FBAR",$J) G END
21REPRNTDQ ;tasked entry point from reprint^fbuclet
22 ;fbnoup=1 if no update of expiration date, = 0 to update
23 U IO S FBFF=0 D STANUM^FBUCUTL2 D:'$P($G(FBUC),U,8) STATADD^FBUCUTL2 I 'FBNOUP K FBNOUP
24 D ARRAY:FBRANGE,STRING:'FBRANGE
25 N FBI S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI D
26 .S FBDA=+$P($G(^TMP("FBARY",$J,FBI)),";")
27 .S FBUCA=$G(^FB583(FBDA,0))
28 .S FBORDER=$$ORDER^FBUCUTL(+$P(FBUCA,U,24))
29 .; if only one type of letter was requested for a batch reprint then
30 .; skip the claim if it's letter is not of that type
31 .I $G(FBLTRTYP),FBLTRTYP'=$$LETTER^FBUCUTL2(FBORDER,+$P(FBUCA,U,28)) Q
32 .D PRINT^FBUCLET1
33 K ^TMP("FBARY",$J) G END
34AUTODQ ;tasked entry point from auto^fbuclet
35 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
36 ;G END
37END 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
38 Q
39STRING ;process string of ien's if not date range/called by reprntdq
40 ;INPUT: FBARY( array of ien of selected unauthorized claims
41 ;OUTPUT: TMP(FBARY,$J array
42 N FBDCT,FBA S (FBDCT,FBA)=0 F S FBA=$O(FBARY(FBA)) Q:'FBA D
43 .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
44 Q
45ARRAY ;set array in tmp for date range
46 ;called by reprntdq if date range selected
47 ;INPUT VARIABLES: FBFR = from date; FBTO = to date
48 N FBARY,FBDCT,FBDT,FBI,FBO,FBORDER,FBZ
49 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
50 I FBO]"" S FBO=FBO_U
51 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
52 .N FBARY S FBDCT=FBDCT+1
53 .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)
54 .S ^TMP("FBARY",$J,FBDCT)=FBARY
55 S FBARY=FBDCT I FBDCT S FBARY=FBARY_";"_"5^20^35^52^63^",^TMP("FBARY",$J,"FBARY")=FBARY
56 Q
Note: See TracBrowser for help on using the repository browser.