- 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 Mar 13, 2025@21:05:51 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
