FBXDIPS ;WIRMFO/SAB-POST INSTALL ;12/9/1998
;;3.5;FEE BASIS;**13**;JAN 30, 1995
;
; only perform during 1st install
I $$PATCH^XPDUTL("FB*3.5*13") D BMES^XPDUTL(" Skipping post install since patch was previously installed.") Q
;
N DA,DIK,FBC,FBAC,FBDA,FBFDA,FBPROG,FBY
;
D BMES^XPDUTL(" Checking Purpose of Visit codes")
S FBPROG=$O(^FBAA(161.8,"B","CHAMPVA",0))
F FBAC=12,13 D
. S FBDA=0 F S FBDA=$O(^FBAA(161.82,"C",FBAC,FBDA)) Q:'FBDA D
. . S FBY=$G(^FBAA(161.82,FBDA,0)) Q:FBY=""
. . Q:$P(FBY,U,2)=FBPROG ; already points to CHAPMVA
. . S FBFDA(161.82,FBDA_",",2)=$S(FBPROG:FBPROG,1:"@")
. . D MES^XPDUTL(" updating fee program for POV with ien "_FBDA)
I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG()
;
D BMES^XPDUTL(" Building new cross-reference for existing authorizations...")
; init variables
S FBC("TOT")=$P($G(^FBAAA(0)),U,4) ; total number of patients to index
S FBC("PAT")=0 ; count of re-indexed patients
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%
. ; build B index for patient authorizations
. K DA S DIK="^FBAAA("_FBDA_",1,",DIK(1)=".01^B",DA(1)=FBDA D ENALL^DIK
;
D MES^XPDUTL(" done.")
;
Q
;FBXDIPS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXDIPS 1615 printed Sep 23, 2025@19:37:02 Page 2
FBXDIPS ;WIRMFO/SAB-POST INSTALL ;12/9/1998
+1 ;;3.5;FEE BASIS;**13**;JAN 30, 1995
+2 ;
+3 ; only perform during 1st install
+4 IF $$PATCH^XPDUTL("FB*3.5*13")
DO BMES^XPDUTL(" Skipping post install since patch was previously installed.")
QUIT
+5 ;
+6 NEW DA,DIK,FBC,FBAC,FBDA,FBFDA,FBPROG,FBY
+7 ;
+8 DO BMES^XPDUTL(" Checking Purpose of Visit codes")
+9 SET FBPROG=$ORDER(^FBAA(161.8,"B","CHAMPVA",0))
+10 FOR FBAC=12,13
Begin DoDot:1
+11 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBAA(161.82,"C",FBAC,FBDA))
if 'FBDA
QUIT
Begin DoDot:2
+12 SET FBY=$GET(^FBAA(161.82,FBDA,0))
if FBY=""
QUIT
+13 ; already points to CHAPMVA
if $PIECE(FBY,U,2)=FBPROG
QUIT
+14 SET FBFDA(161.82,FBDA_",",2)=$SELECT(FBPROG:FBPROG,1:"@")
+15 DO MES^XPDUTL(" updating fee program for POV with ien "_FBDA)
End DoDot:2
End DoDot:1
+16 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
DO MSG^DIALOG()
+17 ;
+18 DO BMES^XPDUTL(" Building new cross-reference for existing authorizations...")
+19 ; init variables
+20 ; total number of patients to index
SET FBC("TOT")=$PIECE($GET(^FBAAA(0)),U,4)
+21 ; count of re-indexed patients
SET FBC("PAT")=0
+22 ; set total for status bar
SET XPDIDTOT=FBC("TOT")
+23 ; initial % required to update status bar
SET FBC("UPD")=5
+24 ;
+25 ; loop thru patients
+26 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBAAA(FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+27 SET FBC("PAT")=FBC("PAT")+1
+28 ; calculate % complete
SET FBC("%")=FBC("PAT")*100/FBC("TOT")
+29 ; check if status bar should be updated
+30 IF FBC("%")>FBC("UPD")
Begin DoDot:2
+31 ; update status bar
DO UPDATE^XPDID(FBC("PAT"))
+32 ; increase update criteria by 5%
SET FBC("UPD")=FBC("UPD")+5
End DoDot:2
+33 ; build B index for patient authorizations
+34 KILL DA
SET DIK="^FBAAA("_FBDA_",1,"
SET DIK(1)=".01^B"
SET DA(1)=FBDA
DO ENALL^DIK
End DoDot:1
+35 ;
+36 DO MES^XPDUTL(" done.")
+37 ;
+38 QUIT
+39 ;FBXDIPS
