IBY623PO ;EDE/WCJ - POST-INSTALL FOR IB*2.0*623 ;13-JUL-2018
;;2.0;INTEGRATED BILLING;**623**;21-MAR-94;Build 70
;;Per VA Directive 6402, this routine should not be modified.
;
; IA# 10141 - MES^XPDUTL
; IA#4677 - $$CREATE^XUSAP
;
EN ;Entry Point
N IBA
S IBA(2)="IB*2*623 Post-Install...",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
D ADDPROXY
D ADDRTYPS
D UPDERR
S IBA(2)="IB*2*623 Post-Install Complete.",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
Q
;
ADDPROXY ;Add APPLICATION PROXY user to file 200. Supported by IA#4677.
N IEN200
D MES^XPDUTL("Adding entry 'IBTAS,APPLICATION PROXY' to the New Person file (#200)")
S IEN200=$$CREATE^XUSAP("IBTAS,APPLICATION PROXY","","IBTAS EBILLING RPCS")
I +IEN200=0 D MES^XPDUTL("........'IBTAS,APPLICATION PROXY' already exists.")
I +IEN200>0 D MES^XPDUTL("........'IBTAS,APPLICATION PROXY' added.")
I IEN200<0 D MES^XPDUTL("........'ERROR: IBTAS,APPLICATION PROXY' NOT added.")
Q
;
ADDRTYPS ;Add the Non-MCCF Rate Types that don't exist in the Non-MCCF Pay-To
;Providers Rate Table (File #350.928) - vd (US141).
N FDA,IBRTYP,LOOP,NONMCCF,Y
S NONMCCF="INTERAGENCY^CHAMPVA REIMB. INS.^CHAMPVA^TRICARE REIMB. INS.^TRICARE^INELIGIBLE^SHARING AGREEMENT^INELIGIBLE REIMB. INS."
S NONMCCF=NONMCCF_"^DOD DISABILITY EVALUATION^DOD SPINAL CORD INJURY^DOD TRAUMATIC BRAIN INJURY^DOD BLIND REHABILITATION^TRICARE DENTAL^TRICARE PHARMACY"
D MES^XPDUTL("Adding missing Rate Types to the Non-MCCF PTP Rate Type File")
F LOOP=1:1 S IBRTYP=$P(NONMCCF,U,LOOP) Q:IBRTYP="" D
. S Y=$O(^DGCR(399.3,"B",IBRTYP,0))
. I $D(^IBE(350.9,1,28,"B",+Y)) Q ; Rate Type already exists in the Non-MCCF PTP Rate Type File - Don't Add.
. ; create entry for Rate Type
. K FDA
. S FDA("350.928","+1,1,",.01)=+Y
. D UPDATE^DIE("","FDA")
. Q
;
UPDERR ; Update existing error code message for 350.8
N IBCODE,IBMESN,IBIEN,DIE,DIC,DA,DR,X,Y
S IBCODE="IB366",IBMESN="Insured's Date of Birth is not a valid date."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB367",IBMESN="Insurance subscriber Date of Birth is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB368",IBMESN="Patient's Date of Birth is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB369",IBMESN="Patient's Date of Death is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB370",IBMESN="Bill Statement Covers From Date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB371",IBMESN="Bill Statement Covers To Date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB372",IBMESN="Unable to Work From date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB373",IBMESN="Unable to Work To date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB374",IBMESN="Date of Initial Treatment is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB375",IBMESN="Last X-Ray Date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB376",IBMESN="Date of Acute Manifestation is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB377",IBMESN="Disability Start Date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB378",IBMESN="Disability End Date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB379",IBMESN="Assumed Care Date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB380",IBMESN="Relinquished Care Date is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB381",IBMESN="Property Casualty Date of 1st Contact is invalid."
S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
S IBCODE="IB382",IBMESN="Date Last Seen is invalid."
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[HIBY623PO 4363 printed Oct 16, 2024@18:35:27 Page 2
IBY623PO ;EDE/WCJ - POST-INSTALL FOR IB*2.0*623 ;13-JUL-2018
+1 ;;2.0;INTEGRATED BILLING;**623**;21-MAR-94;Build 70
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IA# 10141 - MES^XPDUTL
+5 ; IA#4677 - $$CREATE^XUSAP
+6 ;
EN ;Entry Point
+1 NEW IBA
+2 SET IBA(2)="IB*2*623 Post-Install..."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+3 DO ADDPROXY
+4 DO ADDRTYPS
+5 DO UPDERR
+6 SET IBA(2)="IB*2*623 Post-Install Complete."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+7 QUIT
+8 ;
ADDPROXY ;Add APPLICATION PROXY user to file 200. Supported by IA#4677.
+1 NEW IEN200
+2 DO MES^XPDUTL("Adding entry 'IBTAS,APPLICATION PROXY' to the New Person file (#200)")
+3 SET IEN200=$$CREATE^XUSAP("IBTAS,APPLICATION PROXY","","IBTAS EBILLING RPCS")
+4 IF +IEN200=0
DO MES^XPDUTL("........'IBTAS,APPLICATION PROXY' already exists.")
+5 IF +IEN200>0
DO MES^XPDUTL("........'IBTAS,APPLICATION PROXY' added.")
+6 IF IEN200<0
DO MES^XPDUTL("........'ERROR: IBTAS,APPLICATION PROXY' NOT added.")
+7 QUIT
+8 ;
ADDRTYPS ;Add the Non-MCCF Rate Types that don't exist in the Non-MCCF Pay-To
+1 ;Providers Rate Table (File #350.928) - vd (US141).
+2 NEW FDA,IBRTYP,LOOP,NONMCCF,Y
+3 SET NONMCCF="INTERAGENCY^CHAMPVA REIMB. INS.^CHAMPVA^TRICARE REIMB. INS.^TRICARE^INELIGIBLE^SHARING AGREEMENT^INELIGIBLE REIMB. INS."
+4 SET NONMCCF=NONMCCF_"^DOD DISABILITY EVALUATION^DOD SPINAL CORD INJURY^DOD TRAUMATIC BRAIN INJURY^DOD BLIND REHABILITATION^TRICARE DENTAL^TRICARE PHARMACY"
+5 DO MES^XPDUTL("Adding missing Rate Types to the Non-MCCF PTP Rate Type File")
+6 FOR LOOP=1:1
SET IBRTYP=$PIECE(NONMCCF,U,LOOP)
if IBRTYP=""
QUIT
Begin DoDot:1
+7 SET Y=$ORDER(^DGCR(399.3,"B",IBRTYP,0))
+8 ; Rate Type already exists in the Non-MCCF PTP Rate Type File - Don't Add.
IF $DATA(^IBE(350.9,1,28,"B",+Y))
QUIT
+9 ; create entry for Rate Type
+10 KILL FDA
+11 SET FDA("350.928","+1,1,",.01)=+Y
+12 DO UPDATE^DIE("","FDA")
+13 QUIT
End DoDot:1
+14 ;
UPDERR ; Update existing error code message for 350.8
+1 NEW IBCODE,IBMESN,IBIEN,DIE,DIC,DA,DR,X,Y
+2 SET IBCODE="IB366"
SET IBMESN="Insured's Date of Birth is not a valid date."
+3 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+4 SET IBCODE="IB367"
SET IBMESN="Insurance subscriber Date of Birth is invalid."
+5 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+6 SET IBCODE="IB368"
SET IBMESN="Patient's Date of Birth is invalid."
+7 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+8 SET IBCODE="IB369"
SET IBMESN="Patient's Date of Death is invalid."
+9 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+10 SET IBCODE="IB370"
SET IBMESN="Bill Statement Covers From Date is invalid."
+11 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+12 SET IBCODE="IB371"
SET IBMESN="Bill Statement Covers To Date is invalid."
+13 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+14 SET IBCODE="IB372"
SET IBMESN="Unable to Work From date is invalid."
+15 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+16 SET IBCODE="IB373"
SET IBMESN="Unable to Work To date is invalid."
+17 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+18 SET IBCODE="IB374"
SET IBMESN="Date of Initial Treatment is invalid."
+19 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+20 SET IBCODE="IB375"
SET IBMESN="Last X-Ray Date is invalid."
+21 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+22 SET IBCODE="IB376"
SET IBMESN="Date of Acute Manifestation is invalid."
+23 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+24 SET IBCODE="IB377"
SET IBMESN="Disability Start Date is invalid."
+25 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+26 SET IBCODE="IB378"
SET IBMESN="Disability End Date is invalid."
+27 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+28 SET IBCODE="IB379"
SET IBMESN="Assumed Care Date is invalid."
+29 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+30 SET IBCODE="IB380"
SET IBMESN="Relinquished Care Date is invalid."
+31 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+32 SET IBCODE="IB381"
SET IBMESN="Property Casualty Date of 1st Contact is invalid."
+33 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+34 SET IBCODE="IB382"
SET IBMESN="Date Last Seen is invalid."
+35 SET IBIEN=$ORDER(^IBE(350.8,"C",IBCODE,0))
IF 'IBIEN
DO CREATE
+36 QUIT
+37 ;
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 ;
