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

BARADJR9.m

Go to the documentation of this file. 
  1. BARADJR9 ; IHS/SD/POT - CREATE ENTRY IN A/R EDI STND CLAIM ADJ REASON ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE**24**;;OCT 26, 2005;Build 69
  1.  ; IHS/SD/POTT HEAT147789 - v1.8 p24 - updated SARs part2
  1.  ; code cloned from BARADJR7
  1.  ;
  1.  ; *********************************************************************
  1. EN ; EP
  1.  D RPMSREA                   ; Create RPMS Reasons
  1.  D STND                      ; Create new StanJdard Adj
  1.  D CLAIM                     ; Create new Claim Status Codes
  1.  D ^BARVKL0
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. RPMSREA ;
  1.  ; Create new Adjustment Reasons in A/R TABLE ENTRY
  1.  S BARD=";;"
  1.  S BARCNT=0
  1.  D BMES^XPDUTL("Adding New Adjustment Reasons to A/R Table Entry file...")
  1.  F  D RPMSREA2 Q:BARVALUE="END"
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. RPMSREA2 ;
  1.  S BARCNT=BARCNT+1
  1.  S BARVALUE=$P($T(@1+BARCNT),BARD,2,4)
  1.  Q:BARVALUE="END"
  1.  K DIC,DA,X,Y
  1.  S DIC="^BARTBL("
  1.  S DIC(0)="LZE"
  1.  S DINUM=$P(BARVALUE,BARD)
  1.  S X=$P(BARVALUE,BARD,2)
  1.  S DIC("DR")="2////^S X=$P(BARVALUE,BARD,3)"
  1.  K DD,DO
  1.  D MES^XPDUTL($P(BARVALUE,BARD)_"  "_$P(BARVALUE,BARD,2))
  1.  D FILE^DICN
  1.  Q
  1.  ; ********************************************************************
  1. CHNGREA ; EP
  1.  ; Change category of these reasons to Non-Payment
  1.  S BARD=";;"
  1.  S BARCNT=0
  1.  F  D CHNGREA2 Q:BARVALUE="END"
  1.  Q
  1.  ; ********************************************************************
  1. CHNGREA2 ;
  1.  S BARCNT=BARCNT+1
  1.  S BARVALUE=$P($T(@4+BARCNT),BARD,3)
  1.  Q:BARVALUE="END"
  1.  K DIC,DA,X,Y,DIE
  1.  S DIE="^BARTBL("
  1.  S DA=BARVALUE
  1.  S DR="2////^S X=4"
  1.  D ^DIE
  1.  Q
  1.  ; ********************************************************************
  1. STND ;
  1.  ; Create entries in A/R EDI STND CLAIM ADJ REASONS to accomodate
  1.  ; Standard codes added between 6/02 and 9/03.
  1.  S BARD=";;"
  1.  S BARCNT=0
  1.  D BMES^XPDUTL("Updating Standard Adjustment Reasons in A/R EDI STND CLAIM ADJ REASONS file...")
  1.  F  D STND2 Q:BARVALUE="END"
  1.  Q
  1.  ; ********************************************************************
  1. STND2 ;
  1.  S BARCNT=BARCNT+1
  1.  S BARVALUE=$P($T(@2+BARCNT),BARD,2,6)
  1.  Q:BARVALUE="END"
  1. STND3 ;
  1.  ;look for existing entry
  1.  K DIC,DA,X,Y
  1.  S DIC="^BARADJ("
  1.  S DIC(0)="M"
  1.  S X=$P(BARVALUE,BARD)
  1.  D ^DIC
  1.  I +Y>0 D  Q  ;if existing entry found - edit it
  1.  .D MES^XPDUTL($P(BARVALUE,BARD)_$S($L($P(BARVALUE,BARD))=2:"   ",$L($P(BARVALUE,BARD))=1:"    ",1:"  ")_$E($P(BARVALUE,BARD,2),1,65))
  1.  .K DIC,DIE
  1.  .S DIE="^BARADJ("
  1.  .S DA=+Y
  1.  .S DR=".02///^S X=$P(BARVALUE,BARD,2)"              ; Short Desc
  1.  .S DR=DR_";.03////^S X=$P(BARVALUE,BARD,3)"   ; RPMS Cat
  1.  .S DR=DR_";.04////^S X=$P(BARVALUE,BARD,4)"   ; RPMS Type
  1.  .S DR=DR_";101///^S X=$P(BARVALUE,BARD,5)"    ; Long Desc
  1.  .D ^DIE
  1.  ;create new entry if none found
  1.  K DIC,DA,X,Y
  1.  S DIC="^BARADJ("
  1.  S DIC(0)="LZE"
  1.  S X=$P(BARVALUE,BARD)                                     ; Stnd Code
  1.  S DIC("DR")=".02///^S X=$P(BARVALUE,BARD,2)"              ; Short Desc
  1.  S DIC("DR")=DIC("DR")_";.03////^S X=$P(BARVALUE,BARD,3)"   ; RPMS Cat
  1.  S DIC("DR")=DIC("DR")_";.04////^S X=$P(BARVALUE,BARD,4)"   ; RPMS Type
  1.  S DIC("DR")=DIC("DR")_";101///^S X=$P(BARVALUE,BARD,5)"    ; Long Desc
  1.  K DD,DO
  1.  D MES^XPDUTL($P(BARVALUE,BARD)_$S($L($P(BARVALUE,BARD))=2:"   ",$L($P(BARVALUE,BARD))=1:"    ",1:"  ")_$E($P(BARVALUE,BARD,2),1,65))
  1.  D FILE^DICN
  1.  Q
  1.  ; ********************************************************************
  1. CLAIM ;
  1.  ; Populate A/R EDI CLAIM STATUS CODES to accomodate new codes added
  1.  ; between 6/02 and 9/03. Inactivate necessary codes.
  1.  S BARCNT=0
  1.  F  D CLAIM2 Q:BARVALUE="END"
  1.  S BARCNT=0
  1.  F BARVALUE=8,10,11,13,14,28,69,70 D CLAIM3
  1.  Q
  1.  ; ********************************************************************
  1. CLAIM2 ;
  1.  S BARCNT=BARCNT+1
  1.  S BARVALUE=$P($T(@3+BARCNT),BARD,2,4)
  1.  Q:BARVALUE="END"
  1.  K DIC,DA,X,Y
  1.  S DIC="^BARECSC("
  1.  S DIC(0)="LZE"
  1.  S X=$P(BARVALUE,BARD)                        ;Status Cd
  1.  S DIC("DR")="11///^S X=$P(BARVALUE,BARD,2)"  ;Description
  1.  K DD,DO
  1.  D FILE^DICN
  1.  Q
  1.  ; ********************************************************************
  1. CLAIM3 ;
  1.  K DIC,DA,X,Y
  1.  S DIC="^BARECSC("
  1.  S DIC(0)="XZQ"
  1.  S X=BARVALUE
  1.  K DD,DO
  1.  D ^DIC
  1.  Q:+Y<1
  1.  K DA,DIE,DR
  1.  S DA=+Y
  1.  S DIE=DIC
  1.  S DR=".02///Y"
  1.  D ^DIE
  1.  Q
  1.  ; ********************************************************************
  1. MODIFY ; EP
  1.  ; Change PENDING to NON PAYMENT
  1.  S BARD=";;"
  1.  S BARCNT=0
  1.  F  D MODIFY2 Q:BARVALUE="END"
  1.  Q
  1.  ; *********************************************************************
  1. MODIFY2 ;
  1.  S BARCNT=BARCNT+1
  1.  S BARVALUE=$P($T(@4+BARCNT),BARD,2)
  1.  Q:BARVALUE="END"
  1.  K DIC,DA,X,Y,DR
  1.  S DIC="^BARADJ("
  1.  S DIC(0)="Z"
  1.  S X=$P(BARVALUE,BARD)  ;Stnd Code
  1.  K DD,DO
  1.  D ^DIC
  1.  Q:'+Y
  1.  ;
  1.  S DIE=DIC
  1.  S DA=+Y
  1.  S DR=".03////^S X=4"
  1.  D ^DIE
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1.  ; IEN;;NAME;;TABLE TYPE
  1.  ; *********************************************************************
  1. 1 ;; A/R Table Entry file - Adds (S DIC="^BARTBL(")
  1.  ;;END
  1.  ;
  1.  ; ********************************************************************
  1.  ; STND CODE ;; SHORT DESC ;; RPMS CAT ;; RPMS TYP ;; LONG DESC
  1.  ; ********************************************************************
  1. 2 ;;DIC="^BARADJ("
  1.  ;;P1;;State-mandated requirement for property/casulty, see claim payment remark codes;;22;;401;;State-mandated Requirement for Property and Casualty, see Claim Payment Remarks Code for specific explanation. To be used for Property and Casualty only.
  1.  ;;P10;;Payment reduced to zero due to litigation.;;4;;410;;Payment reduced to zero due to litigation. Additional information will be sent following the conclusion of litigation. To be used for Property and Casualty only.
  1.  ;;P11;;The disposition of this claim/service is pending due to litigation.;;21;;411;;The disposition of the related Property & Casualty claim (injury or illness) is pending due to litigation. To be used for Property and Casualty only. (Use only with Group Code OA)
  1.  ;;P12;;WC juridicational fee schedule adjustment.;;4;;412;;Workers' compensation jurisdictional fee schedule adjustment. To be used for Workers' Compensation only.
  1.  ;;P13;;Payment red or denied based on WC jurisdictional regulations or pymt policies.;;4;;413;;Payment reduced or denied based on workers' compensation jurisdictional regulations or payment policies, use only if no other code is applicable. To be used for Workers' Compensation only.
  1.  ;;P14;;Benefit for this svc included in pymt for another svc performed on the same day.;;4;;414;;The Benefit for this Service is included in the payment/allowance for another service/procedure that has been performed on the same day. To be used for Property and Casualty only.
  1.  ;;P15;;WC Medical Treatment Guideline Adjustment;;4;;415;;Workers' Compensation Medical Treatment Guideline Adjustment. To be used for Workers' Compensation only.
  1.  ;;P16;;Medical provider not auth'd/certified to provide trtmt to injured workers.;;4;;416;;Medical provider not authorized/certified to provide treatment to injured workers in this jurisdiction. To be used for Workers' Compensation only. (Use with Group Code CO or OA)
  1.  ;;P17;;Referral not auth'd by attending physician.;;15;;417;;Referral not authorized by attending physician per regulatory requirement. To be used for Property and Casualty only.
  1.  ;;P18;;Proc not listed in the jurisdiction fee schedule. Allowance made for comp svc.;;4;;418;;Procedure is not listed in the jurisdiction fee schedule. An allowance has been made for a comparable service. To be used for Property and Casualty only.
  1.  ;;P19;;Proc has a relative value of zero in the jurisdictional fee sched, no pymt due.;;4;;419;;Procedure has a relative value of zero in the jurisdiction fee schedule, therefore no payment is due. To be used for Property and Casualty only.
  1.  ;;P2;;Not a work related injury/illness and not the liability of the WC carrier;;4;;402;;Not a work related injury/illness and thus not the liability of the workers' compensation carrier. To be used for Workers' Compensation only.
  1.  ;;P20;;Svc not pd under outpatient facility fee schedule.;;4;;420;;Service not paid under jurisdiction allowed outpatient facility fee schedule. To be used for Property and Casualty only.
  1.  ;;END
  1.  ;
  1.  ; ********************************************************************
  1.  ; CLAIM STATUS CODE ;; DESCRIPTION
  1.  ; ********************************************************************
  1. 3 ;; - A/R EDI Claim Status Codes file - Adds DIC="^BARECSC("
  1.  ;;END
  1.  ;
  1.  ; ********************************************************************
  1.  ; STANDARD CODE ;; RPMS REASON
  1.  ; ********************************************************************
  1. 4 ;;A/R Table Entry file - Edits DIE="^BARTBL("
  1.  ;;END;;END