FBXIP158 ;WCIOFO/SLT-PATCH INSTALL ROUTINE ;5/27/2006
;;3.5;FEE BASIS;**158**;JAN 30, 1995;Build 94
Q
;
EN ; post-install entry point
D MES^XPDUTL("Post-install start...")
D ITC,ROPT,UPDSITE,ADJRSN
D CSGR^FBX2P158
D MES^XPDUTL("Post-install complete.")
Q
;
ITC ;Recompile Input Templates
N FBC,DMAX,FBMAX,FBN
S FBMAX=$$ROUSIZE^DILF
D MES^XPDUTL(" Recompiling affected input templates ...")
F FBC=1:1 S FBN=$P($T(TMPL+FBC),";;",2) Q:FBN="" D COMP(FBN,FBMAX)
D MES^XPDUTL(" done.")
Q
;
COMP(TNAME,DMAX) ; Compile the Input Template
N FBIEN,FBRTN,X,Y
;find the ien of the input template
S FBIEN=$O(^DIE("B",TNAME,0)) Q:'FBIEN
;quit if input template not compiled
S FBRTN=$P($G(^DIE(FBIEN,"ROUOLD")),U) Q:FBRTN=""
D MES^XPDUTL(" Compiling "_TNAME_" , compiled routine is "_FBRTN_" ...")
S X=FBRTN,Y=FBIEN
D EN^DIEZ
D MES^XPDUTL(" done.")
D MES^XPDUTL("")
Q
;
ROPT ; remove option from parent option
N POIEN,COIEN,DA,DIK
D MES^XPDUTL(" Removing Option FB FPPS TRANSMIT from FB FPPS UPDATE MENU...")
Q:'$D(^DIC(19,"B","FB FPPS UPDATE MENU"))
S (POIEN,COIEN,DA)=0
S POIEN=$O(^DIC(19,"B","FB FPPS UPDATE MENU",""))
I POIEN S COIEN=$O(^DIC(19,"B","FB FPPS TRANSMIT",""))
I COIEN D
. S DA=$O(^DIC(19,POIEN,10,"B",COIEN,"")) Q:'DA
. S DA(1)=POIEN,DIK="^DIC(19,"_DA(1)_",10,"
. D ^DIK
D MES^XPDUTL(" done.")
Q
;
UPDSITE ; update FEE BASIS SITE PARAMETERS file, MAX #* fields
N SIEN
D MES^XPDUTL(" Updating FEE BASIS SITE PARAMETERS file, MAX #* fields...")
I '$D(^FBAA(161.4,0)) D MES^XPDUTL(" Site Parameters file undefined. Unable to continue.") Q
S SIEN=$P(^FBAA(161.4,0),U,3)
I 'SIEN D MES^XPDUTL(" A single entry is required in Site Parameters. Unable to continue.") Q
I $D(^FBAA(161.4,SIEN)) D
. S $P(^FBAA(161.4,SIEN,"FBNUM"),U,3)=50 ;MAX # PAYMENT LINE ITEMS (#17)
. S $P(^FBAA(161.4,SIEN,"FBNUM"),U,4)=30 ;MAX # CH PAYMENT LINES (#17.1)
. S $P(^FBAA(161.4,SIEN,"FBNUM"),U,5)=30 ;MAX # CNH PAYMENT LINES (#17.2)
D MES^XPDUTL(" done.")
Q
;
ADJRSN ; changed "B1 " to "B1" in the adjustment reason file #161.91
N DIC,DIE,DA,DR,X,Y,NUM,FBC
S X="B1 "
S DIC="^FB(161.91," D ^DIC S NUM=+Y
Q:NUM=-1
; update entry
S DA=NUM
S FBC="B1"
S DR=".01////^S X=FBC"
S DIE="^FB(161.91,"
D ^DIE
Q
;
;
TMPL ;;
;;FBCH EDIT PAYMENT
;;FBCH ENTER PAYMENT
;;FBNH EDIT PAYMENT
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP158 2418 printed Apr 09, 2024@21:06:21 Page 2
FBXIP158 ;WCIOFO/SLT-PATCH INSTALL ROUTINE ;5/27/2006
+1 ;;3.5;FEE BASIS;**158**;JAN 30, 1995;Build 94
+2 QUIT
+3 ;
EN ; post-install entry point
+1 DO MES^XPDUTL("Post-install start...")
+2 DO ITC
DO ROPT
DO UPDSITE
DO ADJRSN
+3 DO CSGR^FBX2P158
+4 DO MES^XPDUTL("Post-install complete.")
+5 QUIT
+6 ;
ITC ;Recompile Input Templates
+1 NEW FBC,DMAX,FBMAX,FBN
+2 SET FBMAX=$$ROUSIZE^DILF
+3 DO MES^XPDUTL(" Recompiling affected input templates ...")
+4 FOR FBC=1:1
SET FBN=$PIECE($TEXT(TMPL+FBC),";;",2)
if FBN=""
QUIT
DO COMP(FBN,FBMAX)
+5 DO MES^XPDUTL(" done.")
+6 QUIT
+7 ;
COMP(TNAME,DMAX) ; Compile the Input Template
+1 NEW FBIEN,FBRTN,X,Y
+2 ;find the ien of the input template
+3 SET FBIEN=$ORDER(^DIE("B",TNAME,0))
if 'FBIEN
QUIT
+4 ;quit if input template not compiled
+5 SET FBRTN=$PIECE($GET(^DIE(FBIEN,"ROUOLD")),U)
if FBRTN=""
QUIT
+6 DO MES^XPDUTL(" Compiling "_TNAME_" , compiled routine is "_FBRTN_" ...")
+7 SET X=FBRTN
SET Y=FBIEN
+8 DO EN^DIEZ
+9 DO MES^XPDUTL(" done.")
+10 DO MES^XPDUTL("")
+11 QUIT
+12 ;
ROPT ; remove option from parent option
+1 NEW POIEN,COIEN,DA,DIK
+2 DO MES^XPDUTL(" Removing Option FB FPPS TRANSMIT from FB FPPS UPDATE MENU...")
+3 if '$DATA(^DIC(19,"B","FB FPPS UPDATE MENU"))
QUIT
+4 SET (POIEN,COIEN,DA)=0
+5 SET POIEN=$ORDER(^DIC(19,"B","FB FPPS UPDATE MENU",""))
+6 IF POIEN
SET COIEN=$ORDER(^DIC(19,"B","FB FPPS TRANSMIT",""))
+7 IF COIEN
Begin DoDot:1
+8 SET DA=$ORDER(^DIC(19,POIEN,10,"B",COIEN,""))
if 'DA
QUIT
+9 SET DA(1)=POIEN
SET DIK="^DIC(19,"_DA(1)_",10,"
+10 DO ^DIK
End DoDot:1
+11 DO MES^XPDUTL(" done.")
+12 QUIT
+13 ;
UPDSITE ; update FEE BASIS SITE PARAMETERS file, MAX #* fields
+1 NEW SIEN
+2 DO MES^XPDUTL(" Updating FEE BASIS SITE PARAMETERS file, MAX #* fields...")
+3 IF '$DATA(^FBAA(161.4,0))
DO MES^XPDUTL(" Site Parameters file undefined. Unable to continue.")
QUIT
+4 SET SIEN=$PIECE(^FBAA(161.4,0),U,3)
+5 IF 'SIEN
DO MES^XPDUTL(" A single entry is required in Site Parameters. Unable to continue.")
QUIT
+6 IF $DATA(^FBAA(161.4,SIEN))
Begin DoDot:1
+7 ;MAX # PAYMENT LINE ITEMS (#17)
SET $PIECE(^FBAA(161.4,SIEN,"FBNUM"),U,3)=50
+8 ;MAX # CH PAYMENT LINES (#17.1)
SET $PIECE(^FBAA(161.4,SIEN,"FBNUM"),U,4)=30
+9 ;MAX # CNH PAYMENT LINES (#17.2)
SET $PIECE(^FBAA(161.4,SIEN,"FBNUM"),U,5)=30
End DoDot:1
+10 DO MES^XPDUTL(" done.")
+11 QUIT
+12 ;
ADJRSN ; changed "B1 " to "B1" in the adjustment reason file #161.91
+1 NEW DIC,DIE,DA,DR,X,Y,NUM,FBC
+2 SET X="B1 "
+3 SET DIC="^FB(161.91,"
DO ^DIC
SET NUM=+Y
+4 if NUM=-1
QUIT
+5 ; update entry
+6 SET DA=NUM
+7 SET FBC="B1"
+8 SET DR=".01////^S X=FBC"
+9 SET DIE="^FB(161.91,"
+10 DO ^DIE
+11 QUIT
+12 ;
+13 ;
TMPL ;;
+1 ;;FBCH EDIT PAYMENT
+2 ;;FBCH ENTER PAYMENT
+3 ;;FBNH EDIT PAYMENT
+4 ;;
