- FBXIP109 ;ALB/RC-PATCH INSTALL ROUTINE ; 12/29/08 1:54pm
- ;;3.5;FEE BASIS;**109**;JAN 30, 1995;Build 10
- Q
- ;
- PS ; post-install entry point
- ; create KIDS checkpoints with call backs
- N FBX
- F FBX="EN" D
- . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP109")
- . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
- Q
- ;
- EN ; Begin Post-Install
- D CF ;Add Conv factors
- D POV ;Update Place of Visit
- Q
- CF ; add conversion factors for calendar year 2009 RBRVS fee schedule
- ; File 162.99 is being updated in the post install because the Fee
- ; Basis software examines this file to determine the latest available
- ; fee schedule. By doing this at the end of the patch installation,
- ; users can continue to use the payment options during the install.
- D BMES^XPDUTL(" Filing conversion factor for RBRVS 2009 fee schedule.")
- N DD,DO,DA,DIE,DR,X,Y
- S DA(1)=0 F S DA(1)=$O(^FB(162.99,DA(1))) Q:'DA(1) D
- . S DA=$O(^FB(162.99,DA(1),"CY","B",2009,0))
- . I DA'>0 D Q:DA'>0
- . . S DIC="^FB(162.99,"_DA(1)_",""CY"",",DIC(0)="L",DIC("P")="162.991A",DLAYGO=162.991
- . . S X=2009
- . . K DD,DO D FILE^DICN
- . . K DIC,DLAYGO
- . . S DA=+Y
- . ;
- . S DIE="^FB(162.99,"_DA(1)_",""CY"","
- . S DR=".02///"_$S(DA(1)=1:20.9150,1:36.0666)
- . D ^DIE
- Q
- POV ;Update Place of Visit
- ;
- ;Add 67,68,69,56
- D BMES^XPDUTL("Updating Place of Visit entries in the FEE BASIS PURPOSE OF VISIT file (#161.82)")
- N FBCNT,X,NEWENTRY,NEWCODE,NEWPOV,POVCHECK
- F FBCNT=1:1 S NEWENTRY=$P($T(NEWTABLE+FBCNT),";;",2) Q:NEWENTRY="EXIT" D
- .S NEWPOV=$P(NEWENTRY,"^",1),NEWCODE=$P(NEWENTRY,"^",2)
- .S POVCHECK=$O(^FBAA(161.82,"C",NEWCODE,"")) D
- ..I POVCHECK D BMES^XPDUTL("Code: "_NEWCODE_" already exists, please verify this entry in the FEE BASIS PURPOSE OF VISIT file (#161.82).") Q
- ..N DIC,DA,DR,DLAYGO,DINUM
- ..S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
- ..S X=NEWPOV,DIC("DR")="3///^S X=NEWCODE",DINUM=NEWCODE
- ..K DD,D0 D FILE^DICN K DIC,DA,DLAYGO
- ;Inactivate POV 20
- N DA,DIE,DR
- S DA=$O(^FBAA(161.82,"B","CLASS IIr DENTAL TREATMENT",""))
- S DIE="^FBAA(161.82,",DR="4///01/01/09"
- D
- .I DA D ^DIE Q
- .D BMES^XPDUTL("Purpose of Visit 20, ""CLASS IIr DENTAL TREATMENT"", does not exist.")
- Q
- NEWTABLE ;New POVs
- ;;Dialysis^56
- ;;Outpatient Maternity Care Services^67
- ;;Bowel and Bladder care: Agency^68
- ;;Bowel and Bladder care: Family caregiver^69
- ;;EXIT
- ;FBXIP109
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP109 2399 printed Mar 13, 2025@21:05:59 Page 2
- FBXIP109 ;ALB/RC-PATCH INSTALL ROUTINE ; 12/29/08 1:54pm
- +1 ;;3.5;FEE BASIS;**109**;JAN 30, 1995;Build 10
- +2 QUIT
- +3 ;
- PS ; post-install entry point
- +1 ; create KIDS checkpoints with call backs
- +2 NEW FBX
- +3 FOR FBX="EN"
- Begin DoDot:1
- +4 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP109")
- +5 IF 'Y
- DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
- End DoDot:1
- +6 QUIT
- +7 ;
- EN ; Begin Post-Install
- +1 ;Add Conv factors
- DO CF
- +2 ;Update Place of Visit
- DO POV
- +3 QUIT
- CF ; add conversion factors for calendar year 2009 RBRVS fee schedule
- +1 ; File 162.99 is being updated in the post install because the Fee
- +2 ; Basis software examines this file to determine the latest available
- +3 ; fee schedule. By doing this at the end of the patch installation,
- +4 ; users can continue to use the payment options during the install.
- +5 DO BMES^XPDUTL(" Filing conversion factor for RBRVS 2009 fee schedule.")
- +6 NEW DD,DO,DA,DIE,DR,X,Y
- +7 SET DA(1)=0
- FOR
- SET DA(1)=$ORDER(^FB(162.99,DA(1)))
- if 'DA(1)
- QUIT
- Begin DoDot:1
- +8 SET DA=$ORDER(^FB(162.99,DA(1),"CY","B",2009,0))
- +9 IF DA'>0
- Begin DoDot:2
- +10 SET DIC="^FB(162.99,"_DA(1)_",""CY"","
- SET DIC(0)="L"
- SET DIC("P")="162.991A"
- SET DLAYGO=162.991
- +11 SET X=2009
- +12 KILL DD,DO
- DO FILE^DICN
- +13 KILL DIC,DLAYGO
- +14 SET DA=+Y
- End DoDot:2
- if DA'>0
- QUIT
- +15 ;
- +16 SET DIE="^FB(162.99,"_DA(1)_",""CY"","
- +17 SET DR=".02///"_$SELECT(DA(1)=1:20.9150,1:36.0666)
- +18 DO ^DIE
- End DoDot:1
- +19 QUIT
- POV ;Update Place of Visit
- +1 ;
- +2 ;Add 67,68,69,56
- +3 DO BMES^XPDUTL("Updating Place of Visit entries in the FEE BASIS PURPOSE OF VISIT file (#161.82)")
- +4 NEW FBCNT,X,NEWENTRY,NEWCODE,NEWPOV,POVCHECK
- +5 FOR FBCNT=1:1
- SET NEWENTRY=$PIECE($TEXT(NEWTABLE+FBCNT),";;",2)
- if NEWENTRY="EXIT"
- QUIT
- Begin DoDot:1
- +6 SET NEWPOV=$PIECE(NEWENTRY,"^",1)
- SET NEWCODE=$PIECE(NEWENTRY,"^",2)
- +7 SET POVCHECK=$ORDER(^FBAA(161.82,"C",NEWCODE,""))
- Begin DoDot:2
- +8 IF POVCHECK
- DO BMES^XPDUTL("Code: "_NEWCODE_" already exists, please verify this entry in the FEE BASIS PURPOSE OF VISIT file (#161.82).")
- QUIT
- +9 NEW DIC,DA,DR,DLAYGO,DINUM
- +10 SET DIC="^FBAA(161.82,"
- SET DIC(0)="L"
- SET DLAYGO=161.82
- +11 SET X=NEWPOV
- SET DIC("DR")="3///^S X=NEWCODE"
- SET DINUM=NEWCODE
- +12 KILL DD,D0
- DO FILE^DICN
- KILL DIC,DA,DLAYGO
- End DoDot:2
- End DoDot:1
- +13 ;Inactivate POV 20
- +14 NEW DA,DIE,DR
- +15 SET DA=$ORDER(^FBAA(161.82,"B","CLASS IIr DENTAL TREATMENT",""))
- +16 SET DIE="^FBAA(161.82,"
- SET DR="4///01/01/09"
- +17 Begin DoDot:1
- +18 IF DA
- DO ^DIE
- QUIT
- +19 DO BMES^XPDUTL("Purpose of Visit 20, ""CLASS IIr DENTAL TREATMENT"", does not exist.")
- End DoDot:1
- +20 QUIT
- NEWTABLE ;New POVs
- +1 ;;Dialysis^56
- +2 ;;Outpatient Maternity Care Services^67
- +3 ;;Bowel and Bladder care: Agency^68
- +4 ;;Bowel and Bladder care: Family caregiver^69
- +5 ;;EXIT
- +6 ;FBXIP109
