FBXEIPS ;WCIOFO/SAB-POST INSTALL ROUTINE ;7/17/1998
;;3.5;FEE BASIS;**14**;JAN 30, 1995
Q
;
EN N FBDA,FBC
D BMES^XPDUTL(" Examining the FEE BASIS PATIENT file...")
; init variables
S FBC("TOT")=$P($G(^FBAAA(0)),U,4) ; total # of patients to evaluate
S FBC("PAT")=0 ; count of evaluated patients
S FBC("HEC")=0 ; count of patients to report to HEC
S XPDIDTOT=FBC("TOT") ; set total for status bar
S FBC("UPD")=5 ; initial % required to update status bar
;
; loop thru patients
S FBDA=0 F S FBDA=$O(^FBAAA(FBDA)) Q:'FBDA D
. S FBC("PAT")=FBC("PAT")+1
. S FBC("%")=FBC("PAT")*100/FBC("TOT") ; calculate % complete
. ; check if status bar should be updated
. I FBC("%")>FBC("UPD") D
. . D UPDATE^XPDID(FBC("PAT")) ; update status bar
. . S FBC("UPD")=FBC("UPD")+5 ; increase update criteria by 5%
. ; evaluate authorizations
. I $$XMIT(FBDA) S FBC("HEC")=FBC("HEC")+1 D EVENT^IVMPLOG(FBDA)
;
D MES^XPDUTL(" "_FBC("PAT")_" FEE BASIS PATIENTs were evaluated.")
D MES^XPDUTL(" Of these, "_FBC("HEC")_" will be included in the next daily transmission to HEC.")
;
Q
;
XMIT(FBDA) ; Should FEE veterans be reported to HEC
N FBDA1,FBRET,FBY0
S FBRET=0 ; assume no authorizations will meet criteria
; reverse loop thru authorizations - stop when any one meets criteria
S FBDA1=" " F S FBDA1=$O(^FBAAA(FBDA,1,FBDA1),-1) Q:'FBDA1 D Q:FBRET
. Q:$P($G(^FBAAA(FBDA,1,FBDA1,"ADEL")),U)="Y" ; ignore Austin Deleted
. S FBY0=$G(^FBAAA(FBDA,1,FBDA1,0))
. Q:$P(FBY0,U,2)<2961001 ; To Date before cutoff date
. Q:$P(FBY0,U,3)="" ; FEE Program required
. ; passed all checks
. S FBRET=1
;
Q FBRET
;
;FBXEIPS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXEIPS 1684 printed Nov 22, 2024@17:11:08 Page 2
FBXEIPS ;WCIOFO/SAB-POST INSTALL ROUTINE ;7/17/1998
+1 ;;3.5;FEE BASIS;**14**;JAN 30, 1995
+2 QUIT
+3 ;
EN NEW FBDA,FBC
+1 DO BMES^XPDUTL(" Examining the FEE BASIS PATIENT file...")
+2 ; init variables
+3 ; total # of patients to evaluate
SET FBC("TOT")=$PIECE($GET(^FBAAA(0)),U,4)
+4 ; count of evaluated patients
SET FBC("PAT")=0
+5 ; count of patients to report to HEC
SET FBC("HEC")=0
+6 ; set total for status bar
SET XPDIDTOT=FBC("TOT")
+7 ; initial % required to update status bar
SET FBC("UPD")=5
+8 ;
+9 ; loop thru patients
+10 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBAAA(FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+11 SET FBC("PAT")=FBC("PAT")+1
+12 ; calculate % complete
SET FBC("%")=FBC("PAT")*100/FBC("TOT")
+13 ; check if status bar should be updated
+14 IF FBC("%")>FBC("UPD")
Begin DoDot:2
+15 ; update status bar
DO UPDATE^XPDID(FBC("PAT"))
+16 ; increase update criteria by 5%
SET FBC("UPD")=FBC("UPD")+5
End DoDot:2
+17 ; evaluate authorizations
+18 IF $$XMIT(FBDA)
SET FBC("HEC")=FBC("HEC")+1
DO EVENT^IVMPLOG(FBDA)
End DoDot:1
+19 ;
+20 DO MES^XPDUTL(" "_FBC("PAT")_" FEE BASIS PATIENTs were evaluated.")
+21 DO MES^XPDUTL(" Of these, "_FBC("HEC")_" will be included in the next daily transmission to HEC.")
+22 ;
+23 QUIT
+24 ;
XMIT(FBDA) ; Should FEE veterans be reported to HEC
+1 NEW FBDA1,FBRET,FBY0
+2 ; assume no authorizations will meet criteria
SET FBRET=0
+3 ; reverse loop thru authorizations - stop when any one meets criteria
+4 SET FBDA1=" "
FOR
SET FBDA1=$ORDER(^FBAAA(FBDA,1,FBDA1),-1)
if 'FBDA1
QUIT
Begin DoDot:1
+5 ; ignore Austin Deleted
if $PIECE($GET(^FBAAA(FBDA,1,FBDA1,"ADEL")),U)="Y"
QUIT
+6 SET FBY0=$GET(^FBAAA(FBDA,1,FBDA1,0))
+7 ; To Date before cutoff date
if $PIECE(FBY0,U,2)<2961001
QUIT
+8 ; FEE Program required
if $PIECE(FBY0,U,3)=""
QUIT
+9 ; passed all checks
+10 SET FBRET=1
End DoDot:1
if FBRET
QUIT
+11 ;
+12 QUIT FBRET
+13 ;
+14 ;FBXEIPS