IBY778PO ;AITC/DTG - Post-Installation for IB patch 778; OCT 04, 2023
;;2.0;INTEGRATED BILLING;**778**;MAR 21,1994;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to ^XPDUTL in ICR #10141
; Reference to ^XPDMENU in ICR #1157
Q
;
POST ; POST-INSTALL
N IBXPD,SITE,XPDIDTOT
; total number of work items
S XPDIDTOT=4
;
;
D MES^XPDUTL("")
;
; Correct the spelling of a specific Type of Plan
D FIXNM(1)
;
;add new option to IBCN INS RPTS
D ADDRPT(2)
;
; add new option to IBCN INS RPTS
D ADDRPT2(3)
;
; update the abbreviations for several Type of Plans
D ABBREV(4)
;
D MES^XPDUTL("") ; Displays the 'Done' message and finishes the progress bar
D BMES^XPDUTL("POST-Install for IB*2.0*778 Completed.")
Q
;============================
;
; HEALTH MAINTENANCE ORGANIZ
FIXNM(IBXPD) ; update name in file 355.1 from HEALTH MAINTENANCE ORGANIZ to HEALTH MAINTENANCE ORGANIZATION
;
S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
N DA,DR,DIE,IBERR,IBIEN,IBNEWNM,IBOLDNM
S IBOLDNM="HEALTH MAINTENANCE ORGANIZ",IBNEWNM="HEALTH MAINTENANCE ORGANIZATION"
S IBIEN=$$FIND1^DIC(355.1,,"MX",IBOLDNM,"","","IBERR")
I 'IBIEN D G FIXEX
. D BMES^XPDUTL("The entry 'HEALTH MAINTENANCE ORGANIZ' for file #355.1 was not found. No change needed")
S DR=".01///"_IBNEWNM
S DA=IBIEN,DIE="^IBE(355.1," D ^DIE
D BMES^XPDUTL("The entry 'HEALTH MAINTENANCE ORGANIZ' for file #355.1 has been changed to")
D BMES^XPDUTL("'HEALTH MAINTENANCE ORGANIZATION'.")
FIXEX ;
;
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
D MES^XPDUTL("-------------")
Q
;
ADDRPT(IBXPD) ; add new report IBCN EDI PAYER ID REPT to IBCN INS RPTS
;
S IBXPD=$G(IBXPD)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_$G(XPDIDTOT))
D MES^XPDUTL("-------------")
D BMES^XPDUTL("Add report option: IBCN EDI PAYER ID REPT")
D MES^XPDUTL(" To Menu: IBCN INS RPTS")
D BMES^XPDUTL(" ")
;
; ICR #1157 for the usage of $$ADD^XPDMENU
;
N IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
S IBOER="",IBCHK=""
;
;
S IBOER=0,IBMENU="IBCN INS RPTS" D
. S IBNAM="IBCN EDI PAYER ID REPT",IBSYN="EP"
. ;
. S IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
. ;
. I IBRET D MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU) Q
. S IBOER=1 D MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
;
ADDRPTQ ; quit point
;
; option remove end point
D BMES^XPDUTL("Add report options to menus was"_($S('IBOER:"",1:" not"))_" successful")
Q
;
ADDRPT2(IBXPD) ; add new report IBCN DUP GRP PLAN BY INS RPT to IBCN INS RPTS
;
S IBXPD=$G(IBXPD)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_$G(XPDIDTOT))
D MES^XPDUTL("-------------")
D BMES^XPDUTL("Add report option: IBCN DUP GRP PLAN BY INS RPT")
D MES^XPDUTL(" To Menu: IBCN INS RPTS")
D BMES^XPDUTL(" ")
;
; ICR #1157 for the usage of $$ADD^XPDMENU
;
N IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
S IBOER="",IBCHK=""
;
;
S IBOER=0,IBMENU="IBCN INS RPTS" D
. S IBNAM="IBCN DUP GRP PLAN BY INS RPT",IBSYN="LD"
. ;
. S IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
. ;
. I IBRET D MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU) Q
. S IBOER=1 D MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
;
ADDRPT2Q ; quit point
;
; option remove end point
D BMES^XPDUTL("Add report options to menus was"_($S('IBOER:"",1:" not"))_" successful")
Q
;
;
ABBREV(IBXPD) ; update the ABBREVIATION field #.02 in the TYPE OF PLAN file #355.1
;
N IBCNT,IBFNDNM,IBL,IBOLDAB,IBONAME,IBNEWAB
S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Changes made (or not made) to the TYPE OF PLAN file #355.1:")
D MES^XPDUTL(" ")
N IBNEWAB,IBOLDAB
F IBCNT=1:1 S IBL=$T(ABLIST+IBCNT),IBOLDAB=$P(IBL,";",3) Q:IBOLDAB="" D
. S IBNEWAB=$P(IBL,";",5),IBONAME=$P(IBL,";",7)
. D UPDAB
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
D MES^XPDUTL("-------------")
Q
;
UPDAB ; save the updated ABBREVIATION #.02 in file #355.1
N DA,DIE,DR,IBERR,IBIEN
S IBIEN=$$FIND1^DIC(355.1,,"MX",IBOLDAB,"","","IBERR")
I 'IBIEN D Q
. D BMES^XPDUTL("'"_IBONAME_"' does not exist with an abbrv. of '"_IBOLDAB_"';")
. D MES^XPDUTL(" therefore, no change.")
S IBFNDNM=$$GET1^DIQ(355.1,IBIEN_",",".01","I")
I IBFNDNM'=IBONAME D Q
. D BMES^XPDUTL("'"_IBONAME_"' does not exist with an abbrv. of '"_IBOLDAB_"';")
. D MES^XPDUTL(" therefore, no change.")
S DR=".02///"_IBNEWAB
S DA=IBIEN,DIE="^IBE(355.1," D ^DIE
D BMES^XPDUTL("'"_IBONAME_"' - abbrv. changed to '"_IBNEWAB_"'")
Q
;
ABLIST ; List of Current and Change To abbreviations
;;CI;;CAT INS;;CATASTROPHIC INSURANCE
;;DENIN;;DENTAL;;DENTAL INSURANCE
;;HSA;;HLTH SYS;;HEALTH SYSTEMS AGENCY (HSA)
;;IN;;INDMNTY;;INCOME PROTECTION (INDEMNITY)
;;IBH;;INPT HSPTL;;INPATIENT (BASIC HOSPITAL)
;;LP;;LAB;;LABS, PROCEDURES, X-RAY, ETC. (ONLY)
;;MCS;;MNGD CARE;;MANAGED CARE SYSTEM (MCS)
;;MEI;;MED EXPS;;MEDICAL EXPENSE (OPT/PROF)
;;MR ADV;;MCR ADV;;MEDICARE ADVANTAGE
;;MS+;;MED SEC+B;;MEDICARE SECONDARY (B EXC)
;;MS;;MED SEC-B;;MEDICARE SECONDARY (NO B EXC)
;;MSP;;MED SUP;;MEDICARE SUPPLEMENTAL
;;SCI;;SPCL CLS;;SPECIAL CLASS INSURANCE
;;SRI;;SPCL RISK;;SPECIAL RISK INSURANCE
;;SDI;;SPCFC DIS;;SPECIFIED DISEASE INSURANCE
;;SEI;;SURG INS;;SURGICAL EXPENSE INSURANCE
;;TS;;TRI SUPP;;TRICARE SUPPLEMENTAL
;;VA SP CL;;VA SPCL CLS;;VA SPECIAL CLASS
;;WCI;;WORK COMP;;WORKERS' COMPENSATION INSURANCE
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY778PO 5694 printed Dec 13, 2024@02:35:28 Page 2
IBY778PO ;AITC/DTG - Post-Installation for IB patch 778; OCT 04, 2023
+1 ;;2.0;INTEGRATED BILLING;**778**;MAR 21,1994;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to ^XPDUTL in ICR #10141
+5 ; Reference to ^XPDMENU in ICR #1157
+6 QUIT
+7 ;
POST ; POST-INSTALL
+1 NEW IBXPD,SITE,XPDIDTOT
+2 ; total number of work items
+3 SET XPDIDTOT=4
+4 ;
+5 ;
+6 DO MES^XPDUTL("")
+7 ;
+8 ; Correct the spelling of a specific Type of Plan
+9 DO FIXNM(1)
+10 ;
+11 ;add new option to IBCN INS RPTS
+12 DO ADDRPT(2)
+13 ;
+14 ; add new option to IBCN INS RPTS
+15 DO ADDRPT2(3)
+16 ;
+17 ; update the abbreviations for several Type of Plans
+18 DO ABBREV(4)
+19 ;
+20 ; Displays the 'Done' message and finishes the progress bar
DO MES^XPDUTL("")
+21 DO BMES^XPDUTL("POST-Install for IB*2.0*778 Completed.")
+22 QUIT
+23 ;============================
+24 ;
+25 ; HEALTH MAINTENANCE ORGANIZ
FIXNM(IBXPD) ; update name in file 355.1 from HEALTH MAINTENANCE ORGANIZ to HEALTH MAINTENANCE ORGANIZATION
+1 ;
+2 SET IBXPD=$GET(IBXPD)
SET XPDIDTOT=$GET(XPDIDTOT)
+3 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+4 DO MES^XPDUTL("-------------")
+5 NEW DA,DR,DIE,IBERR,IBIEN,IBNEWNM,IBOLDNM
+6 SET IBOLDNM="HEALTH MAINTENANCE ORGANIZ"
SET IBNEWNM="HEALTH MAINTENANCE ORGANIZATION"
+7 SET IBIEN=$$FIND1^DIC(355.1,,"MX",IBOLDNM,"","","IBERR")
+8 IF 'IBIEN
Begin DoDot:1
+9 DO BMES^XPDUTL("The entry 'HEALTH MAINTENANCE ORGANIZ' for file #355.1 was not found. No change needed")
End DoDot:1
GOTO FIXEX
+10 SET DR=".01///"_IBNEWNM
+11 SET DA=IBIEN
SET DIE="^IBE(355.1,"
DO ^DIE
+12 DO BMES^XPDUTL("The entry 'HEALTH MAINTENANCE ORGANIZ' for file #355.1 has been changed to")
+13 DO BMES^XPDUTL("'HEALTH MAINTENANCE ORGANIZATION'.")
FIXEX ;
+1 ;
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
+3 DO MES^XPDUTL("-------------")
+4 QUIT
+5 ;
ADDRPT(IBXPD) ; add new report IBCN EDI PAYER ID REPT to IBCN INS RPTS
+1 ;
+2 SET IBXPD=$GET(IBXPD)
+3 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_$GET(XPDIDTOT))
+4 DO MES^XPDUTL("-------------")
+5 DO BMES^XPDUTL("Add report option: IBCN EDI PAYER ID REPT")
+6 DO MES^XPDUTL(" To Menu: IBCN INS RPTS")
+7 DO BMES^XPDUTL(" ")
+8 ;
+9 ; ICR #1157 for the usage of $$ADD^XPDMENU
+10 ;
+11 NEW IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
+12 SET IBOER=""
SET IBCHK=""
+13 ;
+14 ;
+15 SET IBOER=0
SET IBMENU="IBCN INS RPTS"
Begin DoDot:1
+16 SET IBNAM="IBCN EDI PAYER ID REPT"
SET IBSYN="EP"
+17 ;
+18 SET IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
+19 ;
+20 IF IBRET
DO MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU)
QUIT
+21 SET IBOER=1
DO MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
End DoDot:1
+22 ;
ADDRPTQ ; quit point
+1 ;
+2 ; option remove end point
+3 DO BMES^XPDUTL("Add report options to menus was"_($SELECT('IBOER:"",1:" not"))_" successful")
+4 QUIT
+5 ;
ADDRPT2(IBXPD) ; add new report IBCN DUP GRP PLAN BY INS RPT to IBCN INS RPTS
+1 ;
+2 SET IBXPD=$GET(IBXPD)
+3 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_$GET(XPDIDTOT))
+4 DO MES^XPDUTL("-------------")
+5 DO BMES^XPDUTL("Add report option: IBCN DUP GRP PLAN BY INS RPT")
+6 DO MES^XPDUTL(" To Menu: IBCN INS RPTS")
+7 DO BMES^XPDUTL(" ")
+8 ;
+9 ; ICR #1157 for the usage of $$ADD^XPDMENU
+10 ;
+11 NEW IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
+12 SET IBOER=""
SET IBCHK=""
+13 ;
+14 ;
+15 SET IBOER=0
SET IBMENU="IBCN INS RPTS"
Begin DoDot:1
+16 SET IBNAM="IBCN DUP GRP PLAN BY INS RPT"
SET IBSYN="LD"
+17 ;
+18 SET IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
+19 ;
+20 IF IBRET
DO MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU)
QUIT
+21 SET IBOER=1
DO MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
End DoDot:1
+22 ;
ADDRPT2Q ; quit point
+1 ;
+2 ; option remove end point
+3 DO BMES^XPDUTL("Add report options to menus was"_($SELECT('IBOER:"",1:" not"))_" successful")
+4 QUIT
+5 ;
+6 ;
ABBREV(IBXPD) ; update the ABBREVIATION field #.02 in the TYPE OF PLAN file #355.1
+1 ;
+2 NEW IBCNT,IBFNDNM,IBL,IBOLDAB,IBONAME,IBNEWAB
+3 SET IBXPD=$GET(IBXPD)
SET XPDIDTOT=$GET(XPDIDTOT)
+4 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+5 DO MES^XPDUTL("-------------")
+6 DO MES^XPDUTL("Changes made (or not made) to the TYPE OF PLAN file #355.1:")
+7 DO MES^XPDUTL(" ")
+8 NEW IBNEWAB,IBOLDAB
+9 FOR IBCNT=1:1
SET IBL=$TEXT(ABLIST+IBCNT)
SET IBOLDAB=$PIECE(IBL,";",3)
if IBOLDAB=""
QUIT
Begin DoDot:1
+10 SET IBNEWAB=$PIECE(IBL,";",5)
SET IBONAME=$PIECE(IBL,";",7)
+11 DO UPDAB
End DoDot:1
+12 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
+13 DO MES^XPDUTL("-------------")
+14 QUIT
+15 ;
UPDAB ; save the updated ABBREVIATION #.02 in file #355.1
+1 NEW DA,DIE,DR,IBERR,IBIEN
+2 SET IBIEN=$$FIND1^DIC(355.1,,"MX",IBOLDAB,"","","IBERR")
+3 IF 'IBIEN
Begin DoDot:1
+4 DO BMES^XPDUTL("'"_IBONAME_"' does not exist with an abbrv. of '"_IBOLDAB_"';")
+5 DO MES^XPDUTL(" therefore, no change.")
End DoDot:1
QUIT
+6 SET IBFNDNM=$$GET1^DIQ(355.1,IBIEN_",",".01","I")
+7 IF IBFNDNM'=IBONAME
Begin DoDot:1
+8 DO BMES^XPDUTL("'"_IBONAME_"' does not exist with an abbrv. of '"_IBOLDAB_"';")
+9 DO MES^XPDUTL(" therefore, no change.")
End DoDot:1
QUIT
+10 SET DR=".02///"_IBNEWAB
+11 SET DA=IBIEN
SET DIE="^IBE(355.1,"
DO ^DIE
+12 DO BMES^XPDUTL("'"_IBONAME_"' - abbrv. changed to '"_IBNEWAB_"'")
+13 QUIT
+14 ;
ABLIST ; List of Current and Change To abbreviations
+1 ;;CI;;CAT INS;;CATASTROPHIC INSURANCE
+2 ;;DENIN;;DENTAL;;DENTAL INSURANCE
+3 ;;HSA;;HLTH SYS;;HEALTH SYSTEMS AGENCY (HSA)
+4 ;;IN;;INDMNTY;;INCOME PROTECTION (INDEMNITY)
+5 ;;IBH;;INPT HSPTL;;INPATIENT (BASIC HOSPITAL)
+6 ;;LP;;LAB;;LABS, PROCEDURES, X-RAY, ETC. (ONLY)
+7 ;;MCS;;MNGD CARE;;MANAGED CARE SYSTEM (MCS)
+8 ;;MEI;;MED EXPS;;MEDICAL EXPENSE (OPT/PROF)
+9 ;;MR ADV;;MCR ADV;;MEDICARE ADVANTAGE
+10 ;;MS+;;MED SEC+B;;MEDICARE SECONDARY (B EXC)
+11 ;;MS;;MED SEC-B;;MEDICARE SECONDARY (NO B EXC)
+12 ;;MSP;;MED SUP;;MEDICARE SUPPLEMENTAL
+13 ;;SCI;;SPCL CLS;;SPECIAL CLASS INSURANCE
+14 ;;SRI;;SPCL RISK;;SPECIAL RISK INSURANCE
+15 ;;SDI;;SPCFC DIS;;SPECIFIED DISEASE INSURANCE
+16 ;;SEI;;SURG INS;;SURGICAL EXPENSE INSURANCE
+17 ;;TS;;TRI SUPP;;TRICARE SUPPLEMENTAL
+18 ;;VA SP CL;;VA SPCL CLS;;VA SPECIAL CLASS
+19 ;;WCI;;WORK COMP;;WORKERS' COMPENSATION INSURANCE
+20 ;;
