- 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 23, 2025@18:15:51 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 ;;
