source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBXEIPS.m@ 1751

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1FBXEIPS ;WCIOFO/SAB-POST INSTALL ROUTINE ;7/17/1998
2 ;;3.5;FEE BASIS;**14**;JAN 30, 1995
3 Q
4 ;
5EN N FBDA,FBC
6 D BMES^XPDUTL(" Examining the FEE BASIS PATIENT file...")
7 ; init variables
8 S FBC("TOT")=$P($G(^FBAAA(0)),U,4) ; total # of patients to evaluate
9 S FBC("PAT")=0 ; count of evaluated patients
10 S FBC("HEC")=0 ; count of patients to report to HEC
11 S XPDIDTOT=FBC("TOT") ; set total for status bar
12 S FBC("UPD")=5 ; initial % required to update status bar
13 ;
14 ; loop thru patients
15 S FBDA=0 F S FBDA=$O(^FBAAA(FBDA)) Q:'FBDA D
16 . S FBC("PAT")=FBC("PAT")+1
17 . S FBC("%")=FBC("PAT")*100/FBC("TOT") ; calculate % complete
18 . ; check if status bar should be updated
19 . I FBC("%")>FBC("UPD") D
20 . . D UPDATE^XPDID(FBC("PAT")) ; update status bar
21 . . S FBC("UPD")=FBC("UPD")+5 ; increase update criteria by 5%
22 . ; evaluate authorizations
23 . I $$XMIT(FBDA) S FBC("HEC")=FBC("HEC")+1 D EVENT^IVMPLOG(FBDA)
24 ;
25 D MES^XPDUTL(" "_FBC("PAT")_" FEE BASIS PATIENTs were evaluated.")
26 D MES^XPDUTL(" Of these, "_FBC("HEC")_" will be included in the next daily transmission to HEC.")
27 ;
28 Q
29 ;
30XMIT(FBDA) ; Should FEE veterans be reported to HEC
31 N FBDA1,FBRET,FBY0
32 S FBRET=0 ; assume no authorizations will meet criteria
33 ; reverse loop thru authorizations - stop when any one meets criteria
34 S FBDA1=" " F S FBDA1=$O(^FBAAA(FBDA,1,FBDA1),-1) Q:'FBDA1 D Q:FBRET
35 . Q:$P($G(^FBAAA(FBDA,1,FBDA1,"ADEL")),U)="Y" ; ignore Austin Deleted
36 . S FBY0=$G(^FBAAA(FBDA,1,FBDA1,0))
37 . Q:$P(FBY0,U,2)<2961001 ; To Date before cutoff date
38 . Q:$P(FBY0,U,3)="" ; FEE Program required
39 . ; passed all checks
40 . S FBRET=1
41 ;
42 Q FBRET
43 ;
44 ;FBXEIPS
Note: See TracBrowser for help on using the repository browser.