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

IB20P543.m

Go to the documentation of this file.
  1. IB20P543 ;ALB/CXW - UPDATE MCCR UTILITY & REVENUE & POS ; 01/22/2015
  1. ;;2.0;INTEGRATED BILLING;**543**;21-MAR-94;Build 20
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. POST ;
  1. ; Update value/occurrence/condition codes in mccr utility file 399.1
  1. ; Update revenue codes in revenue code file 399.2
  1. ; Update pos code in place of service file 353.1
  1. N IBZ,U S U="^"
  1. D MSG(" IB*2.0*543 Post-Install starts .....")
  1. D MCR,RVC,POS,FORM
  1. D MSG(" IB*2.0*543 Post-Install is complete.")
  1. Q
  1. ;
  1. MCR ; 3 types of codes
  1. N IBCNT,IBCOD,IBPE,IBFD,IBFD2,IBI,IBX S IBFD2=""
  1. ; Value code flag in field #.18/piece 11
  1. S IBCNT=0,IBPE=11,IBFD=.18
  1. D MSG(" >>>Value Code")
  1. F IBI=1:1 S IBX=$P($T(VALU+IBI),";;",2) Q:IBX="Q" D MFILE
  1. ;
  1. ; Condition code flag in field #.22/piece 15
  1. S IBPE=15,IBFD=.22
  1. D MSG(""),MSG(" >>>Condition Code")
  1. F IBI=1:1 S IBX=$P($T(CONU+IBI),";;",2) Q:IBX="Q" D MFILE
  1. ;
  1. ; Occurrence span code flag in fields #.11/piece 4, #.17/piece 10
  1. S IBPE=4,IBFD=.11,IBFD2=.17
  1. D MSG(""),MSG(" >>>Occurrence Span Code")
  1. F IBI=1:1 S IBX=$P($T(OCCPU+IBI),";;",2) Q:IBX="Q" D MFILE
  1. ;
  1. D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the MCCR Utility file (#399.1)")
  1. Q
  1. ;
  1. MFILE ; store in mccr utility file
  1. N IBA,IBB,IBFN,IBFLG,IBMS,IBX3,DLAYGO,DIC,DIE,DA,DD,DO,DR,X,Y
  1. S (IBMS,IBX3)="",IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBFLG=$P(IBX,U,3)
  1. S IBFN=+$$EXCODE(IBA,IBPE) S:IBFN IBX3=$G(^DGCR(399.1,IBFN,0))
  1. I $P(IBX3,U,1)=IBB,$P(IBX3,U,2)=IBA S IBMS="not "_$S('IBFLG:"added",1:"updated") G MFILEQ
  1. I 'IBFLG D
  1. . S DLAYGO=399.1,DIC="^DGCR(399.1,",DIC(0)="L",X=IBB D FILE^DICN
  1. . I Y<1 D MSG(" >> ERROR when adding "_$S(IBPE=11:"Value",IBPE=15:"Condition",1:"Occurrence Span")_" Code #"_IBA_" to the file, Log a Remedy ticket!") Q
  1. . S DA=+Y,DIE=DIC,DR=".02///"_IBA_";"_IBFD_"///"_1 D ^DIE
  1. . S IBMS="added",IBCNT=IBCNT+1
  1. I IBFLG D
  1. . S:IBA="A0" IBFN=+$$EXCODE("RAO",IBPE)
  1. . S DIE="^DGCR(399.1,",DA=IBFN,DR=".01///"_IBB_";.02///"_$S(IBA="A0":IBA,1:"") D ^DIE
  1. . S IBMS="updated",IBCNT=IBCNT+1
  1. MFILEQ I IBMS'="" D MSG(" #"_IBA_" "_IBB_" "_IBMS)
  1. Q
  1. ;
  1. EXCODE(IBCOD,IBPE) ; Returns IEN if code found in the IBPE piece
  1. N IBX,IBY S IBY=""
  1. I $G(IBCOD)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"C",IBCOD,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(IBPE)) S IBY=IBX
  1. Q IBY
  1. ;
  1. RVC ; Revenue code in fields #1/piece 2, #3/piece 4
  1. N IBA,IBB,IBC,IBCNT,IBFLG,IBINA,IBI,IBX,IBY,IBX3,DA,DD,DO,DIE,DR,X,Y
  1. S IBCNT=0
  1. D MSG(""),MSG(" >>>Revenue Code")
  1. F IBI=1:1 S IBX=$P($T(RVCU+IBI),";;",2) Q:IBX="Q" S IBMS="" D
  1. . S IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBC=$P(IBX,U,3)
  1. . S IBFLG=$P(IBX,U,4),IBINA=$P(IBX,U,5)
  1. . S IBY=+$O(^DGCR(399.2,"B",IBA,0)) Q:'IBY
  1. . S IBX3=$G(^DGCR(399.2,IBY,0))
  1. . I 'IBFLG,'IBINA,$P(IBX3,U)=IBA,$P(IBX3,U,2)=IBB S IBMS="not added" G RVCQ
  1. . I IBINA,$P(IBX3,U)=IBA,'$P(IBX3,U,3) S IBMS="not inactivated" G RVCQ
  1. . I IBFLG,$P(IBX3,U)=IBA,$P(IBX3,U,2)=IBB,$P(IBX3,U,4)=IBC S IBMS="not updated" G RVCQ
  1. . ;
  1. . ;4 slashes to override the letter '*'
  1. . I 'IBINA S DR="1////"_IBB_";3////"_IBC_";2///"_$S(IBB="*RESERVED":0,1:1),IBMS=$S(IBFLG:"updated",1:"added")
  1. . I IBINA S DR="2///0",IBMS="inactivated"
  1. . S DIE="^DGCR(399.2,",DA=+IBY D ^DIE
  1. . S IBCNT=IBCNT+1
  1. RVCQ . I IBMS'="" D MSG(" #"_IBA_" "_IBC_" "_IBMS)
  1. D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the Revenue file (#399.2)")
  1. Q
  1. ;
  1. POS ; Place Of Service in fields #.01/piece 1, #.02/piece 2, #.03/piece 3
  1. N IBA,IBB,IBC,IBCNT,IBFLG,IBI,IBMS,IBX,IBX3,IBY,DA,DIC,DIE,DIK,DLAYGO,DD,DO,DR,X,Y
  1. S IBCNT=0,IBX3=""
  1. D MSG(""),MSG(" >>>Place of Service Code")
  1. F IBI=1:1 S IBX=$P($T(POSU+IBI),";;",2) Q:IBX="Q" S IBMS="" D
  1. . S IBA=$P(IBX,U,1),IBB=$P(IBX,U,2)
  1. . S IBC=$P(IBX,U,3),IBFLG=$P(IBX,U,4)
  1. . S IBY=+$O(^IBE(353.1,"B",IBA,0))
  1. . S:IBY IBX3=$G(^IBE(353.1,IBY,0))
  1. . I IBFLG D
  1. .. I 'IBY S IBMS="not removed" Q
  1. .. S DIK="^IBE(353.1," S DA=+IBY D ^DIK
  1. .. S IBCNT=IBCNT+1,IBMS="removed"
  1. . I 'IBFLG D
  1. .. I IBY,$P(IBX3,U)=IBA,$P(IBX3,U,2)=IBB S IBMS="not added" Q
  1. .. S DLAYGO=353.1,DIC="^IBE(353.1,",DIC(0)="L",X=IBA D FILE^DICN
  1. .. I Y<1 K X,Y D MSG(" >> ERROR when adding #"_IBA_" "_IBB_" to the file, Log a Remedy ticket!") Q
  1. .. S DA=+Y,DIE=DIC,DR=".02///"_IBB_";.03///"_IBC D ^DIE
  1. .. S IBCNT=IBCNT+1,IBMS="added"
  1. . I IBMS'="" D MSG(" #"_IBA_" "_IBB_" "_IBMS)
  1. D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the Place of Service file (#353.1)")
  1. D MSG("")
  1. Q
  1. ;
  1. FORM ; 364.6 entry modified to increase the length in field #.9/piece 9
  1. N IBCNT,IBA,IBB,DA,DIE,DR,X,Y
  1. D MSG(" >>>Output Formatter Entry")
  1. S IBA=1682,IBB="OTHER PROC DATE 5 (FL-74E/2)",IBCNT=0
  1. I '$D(^IBA(364.6,IBA)) D MSG(" >> #"_IBA_" "_IBB_" not defined in file (#364.6)") G FORMQ
  1. I $P(^IBA(364.6,IBA,0),U,9)=7 D MSG(" #"_IBA_" "_IBB_" not updated") G FORMQ
  1. S DIE="^IBA(364.6,",DA=IBA,DR=".09///7" D ^DIE
  1. S IBCNT=IBCNT+1
  1. D MSG(" #"_IBA_" "_IBB_" updated")
  1. FORMQ D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the IB Form Skeleton Definition file (#364.6)")
  1. Q
  1. ;
  1. MSG(IBZ) ;
  1. D MES^XPDUTL(IBZ) Q
  1. ;
  1. RVCU ; Revenue code^standard abbreviation^description^update^inactivate (24)
  1. ;;139^OTHER^OTHER^1
  1. ;;175^*RESERVED^*RESERVED^1
  1. ;;599^*RESERVED^*RESERVED^1
  1. ;;630^*RESERVED^*RESERVED^1
  1. ;;680^*RESERVED^*RESERVED^1
  1. ;;690^PRE-HOSPICE/PALLIATIVE CARE SERVICES^GENERAL CLASSIFICATION-PRE-HOSPICE/PALLIATIVE CARE SERVICES
  1. ;;691^VISIT CHARGE^VISIT CHARGE
  1. ;;692^HOURLY CHARGE^HOURLY CHARGE
  1. ;;693^EVALUATION^EVALUATION
  1. ;;694^CONSULTATION AND EDUCATION^CONSULTATION AND EDUCATION
  1. ;;695^INPATIENT CARE^INPATIENT CARE
  1. ;;696^PHYSICIAN SERVICES^PHYSICIAN SERVICES
  1. ;;699^OTHER^OTHER
  1. ;;779^*RESERVED^*RESERVED^1
  1. ;;789^TELEMEDICINE/OTHER^OTHER TELEMEDICINE^^1
  1. ;;815^HEART/CADAVER^CADAVER DONOR-HEART^^1
  1. ;;816^HEART/OTHER^OTHER HEART ACQUISITION^^1
  1. ;;817^LIVER ACQUISIT^DONOR-LIVER^^1
  1. ;;890^*RESERVED^*RESERVED^1
  1. ;;891^DONOR BANK/BONE^BONE^^1
  1. ;;892^DONOR BANK/ORGAN^ORGAN (OTHER THAN KIDNEY)^^1
  1. ;;893^DONOR BANK/SKIN^SKIN^^1
  1. ;;899^OTHER DONOR BANK^OTHER DONOR BANK^^1
  1. ;;970^*RESERVED^*RESERVED^1
  1. ;;Q
  1. ;
  1. VALU ; Value code^name^update (9)
  1. ;;E1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;E2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;E3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;F1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;F2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;F3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;G1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;G2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;G3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;Q
  1. ;
  1. CONU ; Condition code^name^update (11)
  1. ;;55^RESERVED FOR ASSIGNMENT BY THE NUBC^1
  1. ;;A0^TRICARE EXTERNAL PARTNERSHIP PROGRAM^1
  1. ;;R1^REG FOR REOPN RSN CODE-MATH OR COMPUTE MISTAKES
  1. ;;R2^REG FOR REOPN RSN CODE-INACCURATE DATA ENTRY
  1. ;;R3^REG FOR REOPN RSN CODE-MISAPPLICATION OF A FREE SCHEDULE
  1. ;;R4^REG FOR REOPN RSN CODE-COMPUTER ERRORS
  1. ;;R5^REG FOR REOPN RSN CODE-INCORRECT IDENTIFY DUPLICATE CLAIM
  1. ;;R6^REG FPR REOPN RSN CODE-OTH CLER ERR OMIT NOT SPEC IN R1-R5
  1. ;;R7^REG FOR REOPN CODE-CORRECT OTHER THAN CLERICAL ERRORS
  1. ;;R8^REG FOR REOPN CODE-NEW AND MATERIAL EVIDENCE
  1. ;;R9^REG FOR REOPN CODE-FAULTY EVIDENCE
  1. ;;Q
  1. ;
  1. OCCPU ; Occurrence span code^name^update (11)
  1. ;;70^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;71^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;72^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;73^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;74^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;75^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;76^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;77^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;78^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;79^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;80^RESERVED FOR OCCURRENCE SPAN CODES^1
  1. ;;Q
  1. ;
  1. POSU ; Place of Service code^name^abbreviation^remove (3)
  1. ;;18^PLACE OF EMPLOYMENT-WORKSITE^EMPLOYMENT-WORKSITE
  1. ;;GR^NATURE OF INJURY (NCCI)^NATURE OF INJURY (NCCI)^1
  1. ;;NI^NATURE OF INJURY^NATURE OF INJURY^1
  1. ;;Q
  1. ;