1 | FBXEIPS ;WCIOFO/SAB-POST INSTALL ROUTINE ;7/17/1998
|
---|
2 | ;;3.5;FEE BASIS;**14**;JAN 30, 1995
|
---|
3 | Q
|
---|
4 | ;
|
---|
5 | EN 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 | ;
|
---|
30 | XMIT(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
|
---|