IBY778PO.m

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 ---IBY778PO   5694     printed  Mar 13, 2025@21:40:38                                                                                                                                                                                                    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      ;;