| [613] | 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
|
|---|
