BARADJR9 ; IHS/SD/POT - CREATE ENTRY IN A/R EDI STND CLAIM ADJ REASON ;
;;1.8;IHS ACCOUNTS RECEIVABLE**24**;;OCT 26, 2005;Build 69
; IHS/SD/POTT HEAT147789 - v1.8 p24 - updated SARs part2
; code cloned from BARADJR7
;
; *********************************************************************
EN ; EP
D RPMSREA ; Create RPMS Reasons
D STND ; Create new StanJdard Adj
D CLAIM ; Create new Claim Status Codes
D ^BARVKL0
Q
; ********************************************************************
;
RPMSREA ;
; Create new Adjustment Reasons in A/R TABLE ENTRY
S BARD=";;"
S BARCNT=0
D BMES^XPDUTL("Adding New Adjustment Reasons to A/R Table Entry file...")
F D RPMSREA2 Q:BARVALUE="END"
Q
; ********************************************************************
;
RPMSREA2 ;
S BARCNT=BARCNT+1
S BARVALUE=$P($T(@1+BARCNT),BARD,2,4)
Q:BARVALUE="END"
K DIC,DA,X,Y
S DIC="^BARTBL("
S DIC(0)="LZE"
S DINUM=$P(BARVALUE,BARD)
S X=$P(BARVALUE,BARD,2)
S DIC("DR")="2////^S X=$P(BARVALUE,BARD,3)"
K DD,DO
D MES^XPDUTL($P(BARVALUE,BARD)_" "_$P(BARVALUE,BARD,2))
D FILE^DICN
Q
; ********************************************************************
CHNGREA ; EP
; Change category of these reasons to Non-Payment
S BARD=";;"
S BARCNT=0
F D CHNGREA2 Q:BARVALUE="END"
Q
; ********************************************************************
CHNGREA2 ;
S BARCNT=BARCNT+1
S BARVALUE=$P($T(@4+BARCNT),BARD,3)
Q:BARVALUE="END"
K DIC,DA,X,Y,DIE
S DIE="^BARTBL("
S DA=BARVALUE
S DR="2////^S X=4"
D ^DIE
Q
; ********************************************************************
STND ;
; Create entries in A/R EDI STND CLAIM ADJ REASONS to accomodate
; Standard codes added between 6/02 and 9/03.
S BARD=";;"
S BARCNT=0
D BMES^XPDUTL("Updating Standard Adjustment Reasons in A/R EDI STND CLAIM ADJ REASONS file...")
F D STND2 Q:BARVALUE="END"
Q
; ********************************************************************
STND2 ;
S BARCNT=BARCNT+1
S BARVALUE=$P($T(@2+BARCNT),BARD,2,6)
Q:BARVALUE="END"
STND3 ;
;look for existing entry
K DIC,DA,X,Y
S DIC="^BARADJ("
S DIC(0)="M"
S X=$P(BARVALUE,BARD)
D ^DIC
I +Y>0 D Q ;if existing entry found - edit it
.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))
.K DIC,DIE
.S DIE="^BARADJ("
.S DA=+Y
.S DR=".02///^S X=$P(BARVALUE,BARD,2)" ; Short Desc
.S DR=DR_";.03////^S X=$P(BARVALUE,BARD,3)" ; RPMS Cat
.S DR=DR_";.04////^S X=$P(BARVALUE,BARD,4)" ; RPMS Type
.S DR=DR_";101///^S X=$P(BARVALUE,BARD,5)" ; Long Desc
.D ^DIE
;create new entry if none found
K DIC,DA,X,Y
S DIC="^BARADJ("
S DIC(0)="LZE"
S X=$P(BARVALUE,BARD) ; Stnd Code
S DIC("DR")=".02///^S X=$P(BARVALUE,BARD,2)" ; Short Desc
S DIC("DR")=DIC("DR")_";.03////^S X=$P(BARVALUE,BARD,3)" ; RPMS Cat
S DIC("DR")=DIC("DR")_";.04////^S X=$P(BARVALUE,BARD,4)" ; RPMS Type
S DIC("DR")=DIC("DR")_";101///^S X=$P(BARVALUE,BARD,5)" ; Long Desc
K DD,DO
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))
D FILE^DICN
Q
; ********************************************************************
CLAIM ;
; Populate A/R EDI CLAIM STATUS CODES to accomodate new codes added
; between 6/02 and 9/03. Inactivate necessary codes.
S BARCNT=0
F D CLAIM2 Q:BARVALUE="END"
S BARCNT=0
F BARVALUE=8,10,11,13,14,28,69,70 D CLAIM3
Q
; ********************************************************************
CLAIM2 ;
S BARCNT=BARCNT+1
S BARVALUE=$P($T(@3+BARCNT),BARD,2,4)
Q:BARVALUE="END"
K DIC,DA,X,Y
S DIC="^BARECSC("
S DIC(0)="LZE"
S X=$P(BARVALUE,BARD) ;Status Cd
S DIC("DR")="11///^S X=$P(BARVALUE,BARD,2)" ;Description
K DD,DO
D FILE^DICN
Q
; ********************************************************************
CLAIM3 ;
K DIC,DA,X,Y
S DIC="^BARECSC("
S DIC(0)="XZQ"
S X=BARVALUE
K DD,DO
D ^DIC
Q:+Y<1
K DA,DIE,DR
S DA=+Y
S DIE=DIC
S DR=".02///Y"
D ^DIE
Q
; ********************************************************************
MODIFY ; EP
; Change PENDING to NON PAYMENT
S BARD=";;"
S BARCNT=0
F D MODIFY2 Q:BARVALUE="END"
Q
; *********************************************************************
MODIFY2 ;
S BARCNT=BARCNT+1
S BARVALUE=$P($T(@4+BARCNT),BARD,2)
Q:BARVALUE="END"
K DIC,DA,X,Y,DR
S DIC="^BARADJ("
S DIC(0)="Z"
S X=$P(BARVALUE,BARD) ;Stnd Code
K DD,DO
D ^DIC
Q:'+Y
;
S DIE=DIC
S DA=+Y
S DR=".03////^S X=4"
D ^DIE
Q
;
; *********************************************************************
; IEN;;NAME;;TABLE TYPE
; *********************************************************************
1 ;; A/R Table Entry file - Adds (S DIC="^BARTBL(")
;;END
;
; ********************************************************************
; STND CODE ;; SHORT DESC ;; RPMS CAT ;; RPMS TYP ;; LONG DESC
; ********************************************************************
2 ;;DIC="^BARADJ("
;;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.
;;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.
;;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)
;;P12;;WC juridicational fee schedule adjustment.;;4;;412;;Workers' compensation jurisdictional fee schedule adjustment. To be used for Workers' Compensation only.
;;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.
;;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.
;;P15;;WC Medical Treatment Guideline Adjustment;;4;;415;;Workers' Compensation Medical Treatment Guideline Adjustment. To be used for Workers' Compensation only.
;;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)
;;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.
;;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.
;;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.
;;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.
;;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.
;;END
;
; ********************************************************************
; CLAIM STATUS CODE ;; DESCRIPTION
; ********************************************************************
3 ;; - A/R EDI Claim Status Codes file - Adds DIC="^BARECSC("
;;END
;
; ********************************************************************
; STANDARD CODE ;; RPMS REASON
; ********************************************************************
4 ;;A/R Table Entry file - Edits DIE="^BARTBL("
;;END;;END
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
+2 ; IHS/SD/POTT HEAT147789 - v1.8 p24 - updated SARs part2
+3 ; code cloned from BARADJR7
+4 ;
+5 ; *********************************************************************
EN ; EP
+1 ; Create RPMS Reasons
DO RPMSREA
+2 ; Create new StanJdard Adj
DO STND
+3 ; Create new Claim Status Codes
DO CLAIM
+4 DO ^BARVKL0
+5 QUIT
+6 ; ********************************************************************
+7 ;
RPMSREA ;
+1 ; Create new Adjustment Reasons in A/R TABLE ENTRY
+2 SET BARD=";;"
+3 SET BARCNT=0
+4 DO BMES^XPDUTL("Adding New Adjustment Reasons to A/R Table Entry file...")
+5 FOR
DO RPMSREA2
IF BARVALUE="END"
QUIT
+6 QUIT
+7 ; ********************************************************************
+8 ;
RPMSREA2 ;
+1 SET BARCNT=BARCNT+1
+2 SET BARVALUE=$PIECE($TEXT(@1+BARCNT),BARD,2,4)
+3 IF BARVALUE="END"
QUIT
+4 KILL DIC,DA,X,Y
+5 SET DIC="^BARTBL("
+6 SET DIC(0)="LZE"
+7 SET DINUM=$PIECE(BARVALUE,BARD)
+8 SET X=$PIECE(BARVALUE,BARD,2)
+9 SET DIC("DR")="2////^S X=$P(BARVALUE,BARD,3)"
+10 KILL DD,DO
+11 DO MES^XPDUTL($PIECE(BARVALUE,BARD)_" "_$PIECE(BARVALUE,BARD,2))
+12 DO FILE^DICN
+13 QUIT
+14 ; ********************************************************************
CHNGREA ; EP
+1 ; Change category of these reasons to Non-Payment
+2 SET BARD=";;"
+3 SET BARCNT=0
+4 FOR
DO CHNGREA2
IF BARVALUE="END"
QUIT
+5 QUIT
+6 ; ********************************************************************
CHNGREA2 ;
+1 SET BARCNT=BARCNT+1
+2 SET BARVALUE=$PIECE($TEXT(@4+BARCNT),BARD,3)
+3 IF BARVALUE="END"
QUIT
+4 KILL DIC,DA,X,Y,DIE
+5 SET DIE="^BARTBL("
+6 SET DA=BARVALUE
+7 SET DR="2////^S X=4"
+8 DO ^DIE
+9 QUIT
+10 ; ********************************************************************
STND ;
+1 ; Create entries in A/R EDI STND CLAIM ADJ REASONS to accomodate
+2 ; Standard codes added between 6/02 and 9/03.
+3 SET BARD=";;"
+4 SET BARCNT=0
+5 DO BMES^XPDUTL("Updating Standard Adjustment Reasons in A/R EDI STND CLAIM ADJ REASONS file...")
+6 FOR
DO STND2
IF BARVALUE="END"
QUIT
+7 QUIT
+8 ; ********************************************************************
STND2 ;
+1 SET BARCNT=BARCNT+1
+2 SET BARVALUE=$PIECE($TEXT(@2+BARCNT),BARD,2,6)
+3 IF BARVALUE="END"
QUIT
STND3 ;
+1 ;look for existing entry
+2 KILL DIC,DA,X,Y
+3 SET DIC="^BARADJ("
+4 SET DIC(0)="M"
+5 SET X=$PIECE(BARVALUE,BARD)
+6 DO ^DIC
+7 ;if existing entry found - edit it
IF +Y>0
Begin DoDot:1
+8 DO MES^XPDUTL($PIECE(BARVALUE,BARD)_$SELECT($LENGTH($PIECE(BARVALUE,BARD))=2:" ",$LENGTH($PIECE(BARVALUE,BARD))=1:" ",1:" ")_$EXTRACT($PIECE(BARVALUE,BARD,2),1,65))
+9 KILL DIC,DIE
+10 SET DIE="^BARADJ("
+11 SET DA=+Y
+12 ; Short Desc
SET DR=".02///^S X=$P(BARVALUE,BARD,2)"
+13 ; RPMS Cat
SET DR=DR_";.03////^S X=$P(BARVALUE,BARD,3)"
+14 ; RPMS Type
SET DR=DR_";.04////^S X=$P(BARVALUE,BARD,4)"
+15 ; Long Desc
SET DR=DR_";101///^S X=$P(BARVALUE,BARD,5)"
+16 DO ^DIE
End DoDot:1
QUIT
+17 ;create new entry if none found
+18 KILL DIC,DA,X,Y
+19 SET DIC="^BARADJ("
+20 SET DIC(0)="LZE"
+21 ; Stnd Code
SET X=$PIECE(BARVALUE,BARD)
+22 ; Short Desc
SET DIC("DR")=".02///^S X=$P(BARVALUE,BARD,2)"
+23 ; RPMS Cat
SET DIC("DR")=DIC("DR")_";.03////^S X=$P(BARVALUE,BARD,3)"
+24 ; RPMS Type
SET DIC("DR")=DIC("DR")_";.04////^S X=$P(BARVALUE,BARD,4)"
+25 ; Long Desc
SET DIC("DR")=DIC("DR")_";101///^S X=$P(BARVALUE,BARD,5)"
+26 KILL DD,DO
+27 DO MES^XPDUTL($PIECE(BARVALUE,BARD)_$SELECT($LENGTH($PIECE(BARVALUE,BARD))=2:" ",$LENGTH($PIECE(BARVALUE,BARD))=1:" ",1:" ")_$EXTRACT($PIECE(BARVALUE,BARD,2),1,65))
+28 DO FILE^DICN
+29 QUIT
+30 ; ********************************************************************
CLAIM ;
+1 ; Populate A/R EDI CLAIM STATUS CODES to accomodate new codes added
+2 ; between 6/02 and 9/03. Inactivate necessary codes.
+3 SET BARCNT=0
+4 FOR
DO CLAIM2
IF BARVALUE="END"
QUIT
+5 SET BARCNT=0
+6 FOR BARVALUE=8,10,11,13,14,28,69,70
DO CLAIM3
+7 QUIT
+8 ; ********************************************************************
CLAIM2 ;
+1 SET BARCNT=BARCNT+1
+2 SET BARVALUE=$PIECE($TEXT(@3+BARCNT),BARD,2,4)
+3 IF BARVALUE="END"
QUIT
+4 KILL DIC,DA,X,Y
+5 SET DIC="^BARECSC("
+6 SET DIC(0)="LZE"
+7 ;Status Cd
SET X=$PIECE(BARVALUE,BARD)
+8 ;Description
SET DIC("DR")="11///^S X=$P(BARVALUE,BARD,2)"
+9 KILL DD,DO
+10 DO FILE^DICN
+11 QUIT
+12 ; ********************************************************************
CLAIM3 ;
+1 KILL DIC,DA,X,Y
+2 SET DIC="^BARECSC("
+3 SET DIC(0)="XZQ"
+4 SET X=BARVALUE
+5 KILL DD,DO
+6 DO ^DIC
+7 IF +Y<1
QUIT
+8 KILL DA,DIE,DR
+9 SET DA=+Y
+10 SET DIE=DIC
+11 SET DR=".02///Y"
+12 DO ^DIE
+13 QUIT
+14 ; ********************************************************************
MODIFY ; EP
+1 ; Change PENDING to NON PAYMENT
+2 SET BARD=";;"
+3 SET BARCNT=0
+4 FOR
DO MODIFY2
IF BARVALUE="END"
QUIT
+5 QUIT
+6 ; *********************************************************************
MODIFY2 ;
+1 SET BARCNT=BARCNT+1
+2 SET BARVALUE=$PIECE($TEXT(@4+BARCNT),BARD,2)
+3 IF BARVALUE="END"
QUIT
+4 KILL DIC,DA,X,Y,DR
+5 SET DIC="^BARADJ("
+6 SET DIC(0)="Z"
+7 ;Stnd Code
SET X=$PIECE(BARVALUE,BARD)
+8 KILL DD,DO
+9 DO ^DIC
+10 IF '+Y
QUIT
+11 ;
+12 SET DIE=DIC
+13 SET DA=+Y
+14 SET DR=".03////^S X=4"
+15 DO ^DIE
+16 QUIT
+17 ;
+18 ; *********************************************************************
+19 ; IEN;;NAME;;TABLE TYPE
+20 ; *********************************************************************
1 ;; A/R Table Entry file - Adds (S DIC="^BARTBL(")
+1 ;;END
+2 ;
+3 ; ********************************************************************
+4 ; STND CODE ;; SHORT DESC ;; RPMS CAT ;; RPMS TYP ;; LONG DESC
+5 ; ********************************************************************
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 o
nly.
+2 ;;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.
+3 ;;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)
+4 ;;P12;;WC juridicational fee schedule adjustment.;;4;;412;;Workers' compensation jurisdictional fee schedule adjustment. To be used for Workers' Compensation only.
+5 ;;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 b
e used for Workers' Compensation only.
+6 ;;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.
+7 ;;P15;;WC Medical Treatment Guideline Adjustment;;4;;415;;Workers' Compensation Medical Treatment Guideline Adjustment. To be used for Workers' Compensation only.
+8 ;;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 wi
th Group Code CO or OA)
+9 ;;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.
+10 ;;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 on
ly.
+11 ;;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.
+12 ;;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.
+13 ;;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.
+14 ;;END
+15 ;
+16 ; ********************************************************************
+17 ; CLAIM STATUS CODE ;; DESCRIPTION
+18 ; ********************************************************************
3 ;; - A/R EDI Claim Status Codes file - Adds DIC="^BARECSC("
+1 ;;END
+2 ;
+3 ; ********************************************************************
+4 ; STANDARD CODE ;; RPMS REASON
+5 ; ********************************************************************
4 ;;A/R Table Entry file - Edits DIE="^BARTBL("
+1 ;;END;;END
