IBY759PO ;EDE/WCJ - POST-INSTALL FOR IB*2.0*759 ;13-JUL-2018
;;2.0;INTEGRATED BILLING;**759**;21-MAR-94;Build 24
;;Per VA Directive 6402, this routine should not be modified.
;
; IA# 10141 - MES^XPDUTL
;
EN ;Entry Point
N IBA
S IBA(2)="IB*2*759 Post-Install...",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
D UPDERR
;;JWS;7/11/22;reset PCR query date to enable all sites to catchup with PCR data collection
S $P(^IBE(350.9,1,8),"^",22)=""
S IBA(2)="IB*2*759 Post-Install Complete.",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
Q
;
UPDERR ; Update existing error code message for 350.8
N IBCODE,IBMESN,IBIEN,DIE,DIC,DA,DR,X,Y
S IBCODE="IB400",IBMESN="The destination payer is not authorized to receive Medicare"
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB401",IBMESN="excluded services electronically."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
Q
;
CREATE ;Create entry for IB error file in D350.8 if not there
S DIC="^IBE(350.8,",DIC(0)="",X=IBCODE D FILE^DICN K DIC,X
I Y=-1 D MES^XPDUTL(">> IB ERROR - Entry '"_IBCODE_"' was unable to be created <<") Q
S IBIEN=+Y
S DIE="^IBE(350.8,",DA=IBIEN,DR=".02////"_IBMESN_";.03////"_IBCODE_";.04////1;.05////1" D ^DIE K DIE,DIC,DA,DR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY759PO 1274 printed Dec 13, 2024@02:35:23 Page 2
IBY759PO ;EDE/WCJ - POST-INSTALL FOR IB*2.0*759 ;13-JUL-2018
+1 ;;2.0;INTEGRATED BILLING;**759**;21-MAR-94;Build 24
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IA# 10141 - MES^XPDUTL
+5 ;
EN ;Entry Point
+1 NEW IBA
+2 SET IBA(2)="IB*2*759 Post-Install..."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+3 DO UPDERR
+4 ;;JWS;7/11/22;reset PCR query date to enable all sites to catchup with PCR data collection
+5 SET $PIECE(^IBE(350.9,1,8),"^",22)=""
+6 SET IBA(2)="IB*2*759 Post-Install Complete."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+7 QUIT
+8 ;
UPDERR ; Update existing error code message for 350.8
+1 NEW IBCODE,IBMESN,IBIEN,DIE,DIC,DA,DR,X,Y
+2 SET IBCODE="IB400"
SET IBMESN="The destination payer is not authorized to receive Medicare"
+3 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+4 SET IBCODE="IB401"
SET IBMESN="excluded services electronically."
+5 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+6 QUIT
+7 ;
CREATE ;Create entry for IB error file in D350.8 if not there
+1 SET DIC="^IBE(350.8,"
SET DIC(0)=""
SET X=IBCODE
DO FILE^DICN
KILL DIC,X
+2 IF Y=-1
DO MES^XPDUTL(">> IB ERROR - Entry '"_IBCODE_"' was unable to be created <<")
QUIT
+3 SET IBIEN=+Y
+4 SET DIE="^IBE(350.8,"
SET DA=IBIEN
SET DR=".02////"_IBMESN_";.03////"_IBCODE_";.04////1;.05////1"
DO ^DIE
KILL DIE,DIC,DA,DR
+5 QUIT
+6 ;
