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

IB20P443.m

Go to the documentation of this file. 
  1. IB20P443 ;ALB/CXW - UPDATE MCCR UTILITY/REVENUE CODE/PLACE OF SERVICE; 11/02/10
  1.  ;;2.0;INTEGRATED BILLING;**443**;21-MAR-94;Build 9
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1. POST ;
  1.  N U S U="^"
  1.  D VAC,OUC,COC,COCE,RVC,POS
  1.  Q
  1.  ;
  1. VAC ;New value codes in 399.1 (field .18/piece 11)
  1.  N DLAYGO,DIC,DIE,DA,DD,DO,DR,X,Y,IBI,IBX
  1.  D MES^XPDUTL("Adding Value Code..")
  1.  F IBI=1:1 S IBX=$P($T(VACF+IBI),";;",2) Q:IBX=""  D
  1.  . I +$$EXCODE($P(IBX,U,1),11) Q
  1.  . K DD,DO S DLAYGO=399.1,DIC="^DGCR(399.1,",DIC(0)="L",X=$P(IBX,U,2) D FILE^DICN K DIC,DLAYGO I Y<1 K X,Y Q
  1.  . S DA=+Y,DIE="^DGCR(399.1,",DR=".02///"_$P(IBX,U,1)_";.18///"_1 D ^DIE K DIE,DA,DR,X,Y
  1.  . D MES^XPDUTL(" Code# "_$P(IBX,U,1)_" - "_$P(IBX,U,2))
  1.  D MES^XPDUTL("")
  1.  Q
  1. OUC ;Update occurrence codes in file 399.1 (field .11/piece 4)
  1.  N DIE,DA,DR,X,Y,IBI,IBX,IBFN
  1.  D MES^XPDUTL("Updating Occurrence Code..")
  1.  F IBI=1:1 S IBX=$P($T(OUOF+IBI),";;",2) Q:IBX=""  D
  1.  . S IBFN=+$$EXCODE($P(IBX,U,1),4) Q:'IBFN
  1.  . S DIE="^DGCR(399.1,",DA=IBFN,DR=".01///"_$P(IBX,U,2) D ^DIE K DIE,DA,DR,X,Y
  1.  . D MES^XPDUTL(" Code# "_$P(IBX,U,1)_" - "_$P(IBX,U,2))
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. COC ;New condition codes in file 399.1 (field .22/piece 15)
  1.  N DLAYGO,DIC,DIE,DA,DD,DO,DR,X,Y,IBI,IBX
  1.  D MES^XPDUTL("Adding Condition Code..")
  1.  F IBI=1:1 S IBX=$P($T(CONF+IBI),";;",2) Q:IBX=""  D
  1.  . I +$$EXCODE($P(IBX,U,1),15) Q
  1.  . K DD,DO S DLAYGO=399.1,DIC="^DGCR(399.1,",DIC(0)="L",X=$P(IBX,U,2) D FILE^DICN K DIC,DLAYGO I Y<1 K X,Y Q
  1.  . S DA=+Y,DIE="^DGCR(399.1,",DR=".02///"_$P(IBX,U,1)_";.22///"_1 D ^DIE K DIE,DA,DR,X,Y
  1.  . D MES^XPDUTL(" Code# "_$P(IBX,U,1)_" - "_$P(IBX,U,2))
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. COCE ;Update condition codes
  1.  N DIE,DA,DR,X,Y,IBI,IBX,IBFN
  1.  D MES^XPDUTL("Updating Condition Code..")
  1.  F IBI=1:1 S IBX=$P($T(COOF+IBI),";;",2) Q:IBX=""  D
  1.  . S IBFN=+$$EXCODE($P(IBX,U,1),15) Q:'IBFN
  1.  . S DIE="^DGCR(399.1,",DA=IBFN,DR=".01///"_$P(IBX,U,2) D ^DIE K DIE,DA,DR,X,Y
  1.  . D MES^XPDUTL(" Code# "_$P(IBX,U,1)_" - "_$P(IBX,U,2))
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. EXCODE(X,P) ;returns IEN if code found in the P piece
  1.  N IBX,IBY S IBY=""
  1.  I $G(X)'="" S IBX=0 F  S IBX=$O(^DGCR(399.1,"C",X,IBX)) Q:'IBX  I $P($G(^DGCR(399.1,IBX,0)),U,+$G(P)) S IBY=IBX
  1.  Q IBY
  1.  ;
  1. RVC ;New revenue codes in file #399.2 (fd 1/piece 2, fd 3/piece 4)
  1.  N IBI,IBX,IBY,IBZ,DIE,DA,DR,X,Y
  1.  D MES^XPDUTL("Adding Revenue Code..")
  1.  F IBI=1:1 S IBX=$P($T(RVCF+IBI),";;",2) Q:IBX=""  D
  1.  . S IBY=$P(IBX,U,1),IBZ=$G(^DGCR(399.2,+IBY,0)) Q:(+IBY'=+IBZ)!($P(IBZ,U,2)'="*RESERVED")
  1.  . S DA=+IBY,DIE="^DGCR(399.2,",DR="1///"_$P(IBX,U,2)_";3///"_$P(IBX,U,3) D ^DIE K DA,DIE,DR,X,Y
  1.  . D MES^XPDUTL(" Code# "_$P(IBX,U,1)_" - "_$P(IBX,U,3))
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. POS ;Update place of service in file 353.1 (fd .02/piece 2, fd .03/piece 3)
  1.  N IBI,IBX,IBY,IBZ,DIE,DA,DR,X,Y
  1.  D MES^XPDUTL("Updating Place of Service Code..")
  1.  F IBI=1:1 S IBX=$P($T(POSF+IBI),";;",2) Q:IBX=""  D
  1.  . S IBY=$P(IBX,U,1)
  1.  . S IBY=$O(^IBE(353.1,"B",$P(IBX,U,1),0)) Q:'IBY
  1.  . S DA=+IBY,DIE="^IBE(353.1,",DR=".02///"_$P(IBX,U,2)_";.03///"_$P(IBX,U,3) D ^DIE K DA,DIE,DR,X,Y
  1.  . D MES^XPDUTL(" Code# "_$P(IBX,U,1)_" - "_$P(IBX,U,2))
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. RVCF ; - new revenue codes
  1.  ;;392^PROCESSING AND STORAGE^PROCESSING AND STORAGE
  1.  ;;860^MAGNETOENCEPHALOGRAHY (MEG)^GENERAL CLASSIFICATION
  1.  ;;861^MEG^MAGNETOENCEPHALOGRAHY (MEG)
  1.  ;;948^PULMONARY REHABILITATION^PULMONARY REHABILITATION
  1.  ;
  1. VACF ; - new value code
  1.  ;;D5^LAST KT/V READING
  1.  ;
  1. OUOF ; - update occurrence codes
  1.  ;;50^ASSESSMENT DATE
  1.  ;;51^DATE OF LAST KT/V READING
  1.  ;;52^MEDICAL CERTIFICATION/RECERTIFICATION DATE
  1.  ;;54^PHYSICIAN FOLLOW-UP DATE
  1.  ;
  1. CONF ; - new condition codes
  1.  ;;30^NON-RESEARCH SERV PROV TO PTS ENROLL IN QUAL CLINIC TRIAL
  1.  ;;44^INPATIENT ADMISSION CHANGED TO OUTPATIENT
  1.  ;;45^AMBIGUOUS GENDER CATEGORY
  1.  ;;47^TRANSFER FROM ANOTHER HOME HEALTH AGENCY
  1.  ;;59^NON-PRIMARY ESRD FACILITY
  1.  ;;80^HOME DIALYSIS-NURSING FACILITY
  1.  ;;AA^ABORTION PERFORMED DUE TO RAPE
  1.  ;;AB^ABORTION PERFORMED DUE TO INCEST
  1.  ;;AC^ABORT PERF DUE TO SERIOUS FETAL GENE DEFCT, DEFORM OR ABNORM
  1.  ;;AD^ABORT PERF DUE TO LIFE ENDANGERING PHYSICAL CONDITION
  1.  ;;AE^ABORT PERF DUE TO PHYS HLTH OF MOTHER THAT NOT LIFE ENDANGER
  1.  ;;AF^ABORT PERF DUE TO EMOTIONAL/PSYCHOLOGICAL HLTH OF THE MOTHER
  1.  ;;AG^ABORTION PERFORMED DUE TO SOCIAL OR ECONOMIC REASONS
  1.  ;;AH^ELECTIVE ABORTION
  1.  ;;AI^STERILIZATION
  1.  ;;AJ^PAYER RESPONSIBLE FOR COPAYMENT
  1.  ;;AK^AIR AMBULANCE REQUIRED
  1.  ;;AL^SPECIALIZED TRMT/BED UNAVAILABLE-ALTERNATE FAC TRANSPORT
  1.  ;;AM^NON-EMERGENCY MEDICALLY NECESSARY STRETCHER TRANSPORT REQ
  1.  ;;AN^PREADMISSION SCREENING NOT REQUIRED
  1.  ;;B4^ADMISSION UNRELATED TO DISCHARGE ON SAME DAY
  1.  ;;P7^DIRECT INPATIENT ADMISSION FROM EMERGENCY ROOM
  1.  ;;DR^DISASTER RELATED
  1.  ;;H0^DELAYED FILING, STATEMENT OF INTENT SUBMITTED
  1.  ;;H3^GI BLEED
  1.  ;;H4^BACTERIAL PNEUMONIA
  1.  ;;H5^PERICARDITIS
  1.  ;;W2^DUPLICATE OF ORIGINAL BILL
  1.  ;;W3^LEVEL I APPEAL
  1.  ;;W4^LEVEL II APPEAL
  1.  ;;W5^LEVEL III APPEAL
  1.  ;
  1. COOF ; - update condition codes
  1.  ;;17^PATIENT IS HOMELESS
  1.  ;;A7^RZD FOR NATIONAL ASSIGNMENT
  1.  ;;A8^RZD FOR NATIONAL ASSIGNMENT
  1.  ;;D4^CHANGE IN CLINICAL CODES (ICD) FOR DX AND/OR PROCEDURE CODES
  1.  ;;D5^CANCEL TO CORRECT INSURED OR PROVIDER ID
  1.  ;
  1. POSF ; - update place of service code
  1.  ;;99^OTHER PLACE OF SERVICE^OTHER PLACE OF SERV
  1.  ;