IBY576PO ;AITC/JRA - POST-INSTALL FOR IB*2.0*576 ;22-FEB-2017
;;2.0;INTEGRATED BILLING;**576**;21-MAR-94;Build 45
;;Per VA Directive 6402, this routine should not be modified.
;
;
S IBA(2)="IB*2*576 Post-Install...",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
D UPDERR,RIT
S IBA(2)="IB*2*576 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="IB099",IBMESN="Occ. Codes Onset of Illness (11) and LMP (10) not allowed on same bill."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE Q
;
S DIE="^IBE(350.8,",DA=IBIEN,DR=".02////"_IBMESN D ^DIE K DIE,DIC,DA,DR
D MES^XPDUTL(">> Updated IB ERROR Code 'IB099' in D350.8 <<")
Q
;
CREATE ;Create entry for 'IB099' in D350.8 if not there
N Y,IBIEN,FNUM,IEN,NODE0,VAL,PCE3,I,II,MSG,NODE0P3
S DIC="^IBE(350.8,",DIC(0)="",X="IB099" D FILE^DICN K DIC,X
I Y=-1 D MES^XPDUTL(">> IB ERROR - Entry 'IB099' not found in D350.8 and unable to create <<") Q
S IBIEN=+Y
S DIE="^IBE(350.8,",DA=IBIEN,DR=".02////"_IBMESN_";.03////IB099;.04////1;.05////3" D ^DIE K DIE,DIC,DA,DR
Q
;
RIT ; Recompile billing screen templates due to changes to Field #399,.21 cross-references.
N X,Y,DMAX,IBN
D MES^XPDUTL(">> Recompiling Input Templates for Billing Screens ...")
F IBN=1:1:10,"102","10H" D
.S X="IBXS"_$S(IBN=10:"A",IBN="102":"A2",IBN="10H":"AH",1:IBN),Y=$$FIND1^DIC(.402,,"X","IB SCREEN"_IBN,"B"),DMAX=$$ROUSIZE^DILF
.I Y D EN^DIEZ
D MES^XPDUTL(" Recompile Completed.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY576PO 1602 printed Dec 13, 2024@02:34:36 Page 2
IBY576PO ;AITC/JRA - POST-INSTALL FOR IB*2.0*576 ;22-FEB-2017
+1 ;;2.0;INTEGRATED BILLING;**576**;21-MAR-94;Build 45
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 SET IBA(2)="IB*2*576 Post-Install..."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+6 DO UPDERR
DO RIT
+7 SET IBA(2)="IB*2*576 Post-Install Complete."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+8 QUIT
+9 ;
UPDERR ; Update existing error code message for 350.8
+1 NEW IBCODE,IBMESN,IBIEN,DIE,DIC,DA,DR,X,Y
+2 SET IBCODE="IB099"
SET IBMESN="Occ. Codes Onset of Illness (11) and LMP (10) not allowed on same bill."
+3 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
QUIT
+4 ;
+5 SET DIE="^IBE(350.8,"
SET DA=IBIEN
SET DR=".02////"_IBMESN
DO ^DIE
KILL DIE,DIC,DA,DR
+6 DO MES^XPDUTL(">> Updated IB ERROR Code 'IB099' in D350.8 <<")
+7 QUIT
+8 ;
CREATE ;Create entry for 'IB099' in D350.8 if not there
+1 NEW Y,IBIEN,FNUM,IEN,NODE0,VAL,PCE3,I,II,MSG,NODE0P3
+2 SET DIC="^IBE(350.8,"
SET DIC(0)=""
SET X="IB099"
DO FILE^DICN
KILL DIC,X
+3 IF Y=-1
DO MES^XPDUTL(">> IB ERROR - Entry 'IB099' not found in D350.8 and unable to create <<")
QUIT
+4 SET IBIEN=+Y
+5 SET DIE="^IBE(350.8,"
SET DA=IBIEN
SET DR=".02////"_IBMESN_";.03////IB099;.04////1;.05////3"
DO ^DIE
KILL DIE,DIC,DA,DR
+6 QUIT
+7 ;
RIT ; Recompile billing screen templates due to changes to Field #399,.21 cross-references.
+1 NEW X,Y,DMAX,IBN
+2 DO MES^XPDUTL(">> Recompiling Input Templates for Billing Screens ...")
+3 FOR IBN=1:1:10,"102","10H"
Begin DoDot:1
+4 SET X="IBXS"_$SELECT(IBN=10:"A",IBN="102":"A2",IBN="10H":"AH",1:IBN)
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN"_IBN,"B")
SET DMAX=$$ROUSIZE^DILF
+5 IF Y
DO EN^DIEZ
End DoDot:1
+6 DO MES^XPDUTL(" Recompile Completed.")
+7 QUIT
+8 ;