IBY601PO ;EDE/DM - Post-Installation for IB patch 601 ; 01-NOV-2017
;;2.0;INTEGRATED BILLING;**601**;21-MAR-94;Build 14
;;Per VA Directive 6402, this routine should not be modified.
;
POST ; POST ROUTINE(S)
N IBXPD,XPDIDTOT
S XPDIDTOT=2
;
; Send site registration message to FSC
D REGMSG(1)
;
; Check/remove any link from an insurance to the National MBI Payer
D CHKLNK(2)
;
; Displays the 'Done' message and finishes the progress bar
D MES^XPDUTL("")
D MES^XPDUTL("POST-Install Completed.")
Q
;
REGMSG(IBXPD) ; send site registration message to FSC
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Sending site registration message to FSC ... ")
I '$$PROD^XUPROD(1) D MES^XPDUTL(" N/A - Not a production account - No site registration message sent") G REGMSGQ
D MES^XPDUTL("Sending site registration message to FSC ... ")
D ^IBCNEHLM
;
REGMSGQ ;
Q
;
CHKLNK(IBXPD) ; Due to a timing issue with the National MBI Payer
;It's possible that a client linked an insurance to the MBI payer
;This is not allowed. Any such link will be removed
N IBMBIPYR,IBIEN
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Verifying Insurance links to payers...")
S IBMBIPYR=0
S IBMBIPYR=$O(^IBE(365.12,"B","CMS MBI ONLY",IBMBIPYR))
I 'IBMBIPYR D BMES^XPDUTL("MBI Payer has not been established") G CHKLNKQ
S IBIEN=0
F S IBIEN=$O(^DIC(36,"AC",IBMBIPYR,IBIEN)) Q:'IBIEN D
. S DIE="^DIC(36,",DA=IBIEN,DR="3.1///@" D ^DIE ; remove the link
. W !,"Insurance:"_IBIEN_" "_$$GET1^DIQ(36,IBIEN_",","NAME")
. K DIE,DA,DR
;
CHKLNKQ ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY601PO 1683 printed Dec 13, 2024@02:34:46 Page 2
IBY601PO ;EDE/DM - Post-Installation for IB patch 601 ; 01-NOV-2017
+1 ;;2.0;INTEGRATED BILLING;**601**;21-MAR-94;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
POST ; POST ROUTINE(S)
+1 NEW IBXPD,XPDIDTOT
+2 SET XPDIDTOT=2
+3 ;
+4 ; Send site registration message to FSC
+5 DO REGMSG(1)
+6 ;
+7 ; Check/remove any link from an insurance to the National MBI Payer
+8 DO CHKLNK(2)
+9 ;
+10 ; Displays the 'Done' message and finishes the progress bar
+11 DO MES^XPDUTL("")
+12 DO MES^XPDUTL("POST-Install Completed.")
+13 QUIT
+14 ;
REGMSG(IBXPD) ; send site registration message to FSC
+1 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+2 DO MES^XPDUTL("-------------")
+3 DO MES^XPDUTL("Sending site registration message to FSC ... ")
+4 IF '$$PROD^XUPROD(1)
DO MES^XPDUTL(" N/A - Not a production account - No site registration message sent")
GOTO REGMSGQ
+5 DO MES^XPDUTL("Sending site registration message to FSC ... ")
+6 DO ^IBCNEHLM
+7 ;
REGMSGQ ;
+1 QUIT
+2 ;
CHKLNK(IBXPD) ; Due to a timing issue with the National MBI Payer
+1 ;It's possible that a client linked an insurance to the MBI payer
+2 ;This is not allowed. Any such link will be removed
+3 NEW IBMBIPYR,IBIEN
+4 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+5 DO MES^XPDUTL("-------------")
+6 DO MES^XPDUTL("Verifying Insurance links to payers...")
+7 SET IBMBIPYR=0
+8 SET IBMBIPYR=$ORDER(^IBE(365.12,"B","CMS MBI ONLY",IBMBIPYR))
+9 IF 'IBMBIPYR
DO BMES^XPDUTL("MBI Payer has not been established")
GOTO CHKLNKQ
+10 SET IBIEN=0
+11 FOR
SET IBIEN=$ORDER(^DIC(36,"AC",IBMBIPYR,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+12 ; remove the link
SET DIE="^DIC(36,"
SET DA=IBIEN
SET DR="3.1///@"
DO ^DIE
+13 WRITE !,"Insurance:"_IBIEN_" "_$$GET1^DIQ(36,IBIEN_",","NAME")
+14 KILL DIE,DA,DR
End DoDot:1
+15 ;
CHKLNKQ ;
+1 QUIT
+2 ;
