Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY592PO

IBY592PO.m

Go to the documentation of this file. 
  1. IBY592PO ;EDE/JWS - POST-INSTALL FOR IB*2.0*592 ;22-FEB-2017
  1.  ;;2.0;INTEGRATED BILLING;**592**;21-MAR-94;Build 58
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; IA# 10009 - FILE^DICN
  1.  ; IA# 10018 - ^DIE
  1.  ; IA# 2053 - UPDATE^DIE
  1.  ; IA# 10141 - MES^XPDUTL
  1.  ;
  1. EN ;Entry Point
  1.  S IBA(2)="IB*2*592 Post-Install...",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
  1.  D UPDERR,UPDTOS,RPTYP,RIT,COMP
  1.  ; set default processing of Dental Claims to YES in Site Parameters
  1.  S DIE="^IBE(350.9,",DA=1,DR="8.2////1" D ^DIE
  1.  S IBA(2)="IB*2*592 Post-Install Complete.",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
  1.  Q
  1.  ;
  1. UPDERR ; Update existing error code message for 350.8
  1.  N IBCODE,IBMESN,IBIEN,DIE,DIC,DA,DR,X,Y
  1.  S IBCODE="IB357",IBMESN="Rendering Provider or Assistant Surgeon required on Dental Claims."
  1.  S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
  1.  S IBCODE="IB358",IBMESN="Assistant Surgeon's NPI is required."
  1.  S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
  1.  S IBCODE="IB256",IBMESN="Assistant Surgeon taxonomy missing."
  1.  S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
  1.  S IBCODE="IB335",IBMESN="Claim Level Assistant Surgeon differs from all Line Level Assistant Surgeons."
  1.  S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
  1.  S IBCODE="IB359",IBMESN="Medicare (WNR) does not accept Dental claims."
  1.  S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
  1.  S IBCODE="IB362",IBMESN="Insurance Company does not have Dental Coverage."
  1.  S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
  1.  S IBCODE="IB363",IBMESN="Claim Level Rendering and Asst Surgeon NOT allowed on same Dental Claim."
  1.  S IBIEN=$O(^IBE(350.8,"C",IBCODE,0)) I 'IBIEN D CREATE
  1.  Q
  1.  ;
  1. CREATE ;Create entry for IB error file in D350.8 if not there
  1.  S DIC="^IBE(350.8,",DIC(0)="",X=IBCODE D FILE^DICN K DIC,X
  1.  I Y=-1 D MES^XPDUTL(">> IB ERROR - Entry '"_IBCODE_"' was unable to be created <<") Q
  1.  S IBIEN=+Y
  1.  S DIE="^IBE(350.8,",DA=IBIEN,DR=".02////"_IBMESN_";.03////"_IBCODE_";.04////1;.05////1" D ^DIE K DIE,DIC,DA,DR
  1.  Q
  1.  ;
  1. UPDTOS ;Create Type of Service entries for Dental file 353.2
  1.  N IBFDA,I,IBIEN,ERROR,CT
  1.  F I=23,24,25,26,27,28,35,36,37,38,39,40,41,"E12","E13","E14","E15","E16","E17","E18","E19","E20","E21","E22","E23","F3","F7" D
  1.  . I $O(^IBE(353.2,"B",I,0)) Q  ;already exists
  1.  . S IBFDA(353.2,"+1,",.01)=I
  1.  . I +I<29 D
  1.  .. S IBFDA(353.2,"+1,",.02)=$P("DIAGNOSTIC DENTAL,PERIODONTICS,RESTORATIVE,ENDODONTICS,MAXILLOFACIAL PROSTHETICS,ADJUNCTIVE DENTAL SERVICES",",",I-22)
  1.  .. S IBFDA(353.2,"+1,",.03)=$P("DIAGNOSTIC DENTAL,PERIODONTICS,RESTORATIVE,ENDODONTICS,MAXILLOFACIAL PRO,ADJUNCTIVE SERVICES",",",I-22)
  1.  . I +I>34,+I<42 D
  1.  .. S IBFDA(353.2,"+1,",.02)=$P("DENTAL CARE,DENTAL CROWNS,DENTAL ACCIDENT,ORTHODONTICS,PROSTHODONTICS,ORAL SURGERY,PREVENTIVE DENTAL",",",I-34)
  1.  .. S IBFDA(353.2,"+1,",.03)=$P("DENTAL CARE,DENTAL CROWNS,DENTAL ACCIDENT,ORTHODONTICS,PROSTHODONTICS,ORAL SURGERY,PREVENTIVE DENTAL",",",I-34)
  1.  . I $E(I)="E" D
  1.  .. S CT=$E(I,2,3)
  1.  .. I CT<18 S IBFDA(353.2,"+1,",.02)=$P("BASIC RESTORATIVE - DENTAL,MAJOR RESTORATIVE - DENTAL,FIXED PROSTHODONTICS,REMOVABLE PROSTHODONTICS,INTRAORAL IMAGES - COMPLETE SERIES,ORAL EVALUATION",",",CT-11)
  1.  .. I CT>17 S IBFDA(353.2,"+1,",.02)=$P("DENTAL PROPHYLAXIS,PANORAMIC IMAGES,SEALANTS,FLOURIDE TREATMENTS,DENTAL IMPLANTS,TEMPOROMANDIBULAR JOINT DYSFUNCTION",",",CT-17)
  1.  .. S IBFDA(353.2,"+1,",.03)=$P("BASIC RESTORATIVE,MAJOR RESTORATIVE,FIXED PROSTH,REMOVABLE PROSTH,IMAGES - COMPLETE,ORAL EVALUATION,PROPHYLAXIS,PANORAMIC IMAGES,SEALANTS,FLOURIDE,DENTAL IMPLANTS,JOINT DYSFUNCTION",",",CT-11)
  1.  . I I="F3" D
  1.  .. S IBFDA(353.2,"+1,",.02)="DENTAL COVERAGE"
  1.  .. S IBFDA(353.2,"+1,",.03)="DENTAL COVERAGE"
  1.  . I I="F7" D
  1.  .. S IBFDA(353.2,"+1,",.02)="ORTHODONTIA COVERAGE"
  1.  .. S IBFDA(353.2,"+1,",.03)="ORTHODONTIA COVERAGE"
  1.  . D UPDATE^DIE("","IBFDA","IBIEN","ERROR")
  1.  . I $D(ERROR) D MES^XPDUTL(">> IB ERROR - IB*2.0*592 Post Install - "_$G(ERROR("DIERR",1,"TEXT",1))_" <<")
  1.  . K IBIEN,ERROR
  1.  Q
  1.  ;
  1. RPTYP ;add IB ATTACHMENT REPORT TYPE (353.3) 'P6'
  1.  N IBRPT,IBMESN,IBIEN,DIE,DIC,DA,DR,X,Y
  1.  S IBRPT="P6",IBMESN="Periodontal Charts"
  1.  S IBIEN=$O(^IBE(353.3,"B",IBRPT,0)) I 'IBIEN D
  1.  . S DIC="^IBE(353.3,",DIC(0)="",X=IBRPT D FILE^DICN K DIC,X
  1.  . I Y=-1 D MES^XPDUTL(">> IB ATTACHMENT REPORT TYPE - Entry '"_IBRPT_"' was unable to be created <<") Q
  1.  . S IBIEN=+Y
  1.  . S DIE="^IBE(353.3,",DA=IBIEN,DR="1////"_IBMESN D ^DIE K DIE,DIC,DA,DR
  1.  . Q
  1.  K DIE,DIC,DA,DR
  1.  S IBRPT="EB",IBIEN=$O(^IBE(353.3,"B",IBRPT,0)) I 'IBIEN Q
  1.  S DIE="^IBE(353.3,",DA=IBIEN,DR="1////Explanation of Benefits (COB or Medicare Secondary Payor)"
  1.  D ^DIE K DIE,DIC,DA,DR
  1.  Q
  1.  ;
  1.  ;
  1. RIT ; Recompile billing screen templates due to changes to Field #399,.21 cross-references.
  1.  N X,Y,DMAX,IBN
  1.  D MES^XPDUTL(">> Recompiling Input Templates for Billing Screens ...")
  1.  F IBN=1:1:10,"102","10H" D
  1.  .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
  1.  .I Y D EN^DIEZ
  1.  D MES^XPDUTL("     Recompile Completed.")
  1.  Q
  1.  ;
  1. COMP ; Recompile index routines for file 399 - found at Kansas City IOC site
  1.  ; IA# 10096 - %ZOSF
  1.  ; IA# 10025 - EN^DIKZ
  1.  ; IA# 2649 - ROUSIZE^DILF
  1.  N X,Y,DMAX
  1.  D MES^XPDUTL(">> Recompiling File 399 Index routines ...")
  1.  ;D OS^DII
  1.  ;I '$D(DISYS)#10 D
  1.  ;. I $D(^%ZOSF("OS"))#2 S DISYS=+$P(^("OS"),"^",2) Q:DISYS>0
  1.  ;. S DISYS=$S($D(^DD("OS"))#2:^("OS"),1:100)
  1.  S X="IBXX",Y=399
  1.  S DMAX=$$ROUSIZE^DILF
  1.  D EN^DIKZ
  1.  D MES^XPDUTL("     Recompile Completed.")
  1.  Q
  1.  ;