FBXIP110 ;ALB/RC -FB*3.5*110 POST INSTALL ROUTINE ; 3/4/09 7:21pm
;;3.5;FEE BASIS;**110**;;Build 8
Q
EN ;post-install entry point
;create KIDS checkpoints with call backs
N FBX,Y
S FBX="POST" D
.S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP110")
.I 'Y D BMES^XPDUTL("ERROR creating "_FBX_" checkpoint.")
Q
POST ;begin post-install
D RVU
D UPD
Q
RVU ;update RVUs for 67113
N CPT,DA,DIE,DR
S CPT="67113",DA="",DA(1)=""
S DA(1)=$$FIND1^DIC(162.97,,"MX","67113")
S DIE="^FB(162.97,"_DA(1)_",""CY"","
S DA=$$FIND1^DIC(162.971,$$IENS^DILF(.DA),"MX","2008")
S DR=".03///25.00;.04///13.75;.05///13.75"
D ^DIE
K CPT,DA,DIE,DR
Q
UPD ;update entries for POV 56,67,78,69
D BMES^XPDUTL("Updating Place of Visit entries in the FEE BASIS PURPOSE OF VISIT file (#161.82)")
N FBCNT,X,UPDENTRY,UPDNAME,UPDCODE,UPDPROG,POVCHECK
F FBCNT=1:1 S UPDENTRY=$P($T(UPDTABLE+FBCNT),";;",2) Q:UPDENTRY="EXIT" D
.S UPDCODE=$P(UPDENTRY,"^",1),UPDNAME=$P(UPDENTRY,"^",2),UPDPROG=$P(UPDENTRY,"^",3)
.S POVCHECK=$O(^FBAA(161.82,"C",UPDCODE,"")) D
..I 'POVCHECK D BMES^XPDUTL("POV "_UPDCODE_" not found, please verify this entry in the FEE BASIS PURPOSE of VISIT file (#161.82).") Q
..N DIE,DA,DR
..S DA=$$FIND1^DIC(161.82,,"MX",UPDCODE)
..S DIE="^FBAA(161.82,"
..S DR=".01///^S X=UPDNAME;2///^S X=UPDPROG"
..D ^DIE K DIE,DA,DR
Q
UPDTABLE ;updates to the POVS
;;56^DIALYSIS^OUTPATIENT
;;67^OUTPATIENT MATERNITY CARE SERVICES^OUTPATIENT
;;68^BOWEL AND BLADDER CARE: AGENCY^OUTPATIENT
;;69^BOWEL AND BLADDER CARE: FAMILY CAREGIVER^OUTPATIENT
;;EXIT
;FBXIP110
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP110 1595 printed Nov 22, 2024@17:11:16 Page 2
FBXIP110 ;ALB/RC -FB*3.5*110 POST INSTALL ROUTINE ; 3/4/09 7:21pm
+1 ;;3.5;FEE BASIS;**110**;;Build 8
+2 QUIT
EN ;post-install entry point
+1 ;create KIDS checkpoints with call backs
+2 NEW FBX,Y
+3 SET FBX="POST"
Begin DoDot:1
+4 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP110")
+5 IF 'Y
DO BMES^XPDUTL("ERROR creating "_FBX_" checkpoint.")
End DoDot:1
+6 QUIT
POST ;begin post-install
+1 DO RVU
+2 DO UPD
+3 QUIT
RVU ;update RVUs for 67113
+1 NEW CPT,DA,DIE,DR
+2 SET CPT="67113"
SET DA=""
SET DA(1)=""
+3 SET DA(1)=$$FIND1^DIC(162.97,,"MX","67113")
+4 SET DIE="^FB(162.97,"_DA(1)_",""CY"","
+5 SET DA=$$FIND1^DIC(162.971,$$IENS^DILF(.DA),"MX","2008")
+6 SET DR=".03///25.00;.04///13.75;.05///13.75"
+7 DO ^DIE
+8 KILL CPT,DA,DIE,DR
+9 QUIT
UPD ;update entries for POV 56,67,78,69
+1 DO BMES^XPDUTL("Updating Place of Visit entries in the FEE BASIS PURPOSE OF VISIT file (#161.82)")
+2 NEW FBCNT,X,UPDENTRY,UPDNAME,UPDCODE,UPDPROG,POVCHECK
+3 FOR FBCNT=1:1
SET UPDENTRY=$PIECE($TEXT(UPDTABLE+FBCNT),";;",2)
if UPDENTRY="EXIT"
QUIT
Begin DoDot:1
+4 SET UPDCODE=$PIECE(UPDENTRY,"^",1)
SET UPDNAME=$PIECE(UPDENTRY,"^",2)
SET UPDPROG=$PIECE(UPDENTRY,"^",3)
+5 SET POVCHECK=$ORDER(^FBAA(161.82,"C",UPDCODE,""))
Begin DoDot:2
+6 IF 'POVCHECK
DO BMES^XPDUTL("POV "_UPDCODE_" not found, please verify this entry in the FEE BASIS PURPOSE of VISIT file (#161.82).")
QUIT
+7 NEW DIE,DA,DR
+8 SET DA=$$FIND1^DIC(161.82,,"MX",UPDCODE)
+9 SET DIE="^FBAA(161.82,"
+10 SET DR=".01///^S X=UPDNAME;2///^S X=UPDPROG"
+11 DO ^DIE
KILL DIE,DA,DR
End DoDot:2
End DoDot:1
+12 QUIT
UPDTABLE ;updates to the POVS
+1 ;;56^DIALYSIS^OUTPATIENT
+2 ;;67^OUTPATIENT MATERNITY CARE SERVICES^OUTPATIENT
+3 ;;68^BOWEL AND BLADDER CARE: AGENCY^OUTPATIENT
+4 ;;69^BOWEL AND BLADDER CARE: FAMILY CAREGIVER^OUTPATIENT
+5 ;;EXIT
+6 ;FBXIP110
