Routine: BARADJR2

BARADJR2 ; IHS/SD/LSL - CREATE ENTRY IN A/R EDI STND CLAIM ADJ REASON ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ; IHS/SD/LSL - 11/06/03 - V1.7 Patch 4 - routine created

 ;     For HIPAA compliance.  Ceate new entries in A/R EDI STND ADJ

 ;     REASON CODES for new codes added since 6/02.  Also create new

 ;     RPMS reason codes for the standard codes to map to.

 ; *********************************************************************

EN ; EP

 D RPMSREA                   ; Create RPMS Reasons

 D STND                      ; Create new StanJdard Adj

 D CLAIM                     ; Create new Claim Status Codes

 D ^BARVKL0

 ; ********************************************************************

RPMSREA ;

 ; Create new Adjustment Reasons in A/R TABLE ENTRY

 S BARD=";;"

 S BARCNT=0

 F  D RPMSREA2 Q:BARVALUE="END"

 ; ********************************************************************

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 FILE^DICN

 ; ********************************************************************

 ; ********************************************************************

CHNGREA ; EP

 ; Change category of these reasons to Non-Payment

 S BARD=";;"

 S BARCNT=0

 F  D CHNGREA2 Q:BARVALUE="END"

 ; ********************************************************************

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

 ; ********************************************************************

 ; ********************************************************************

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

 F  D STND2 Q:BARVALUE="END"

 ; ********************************************************************

STND2 ;

 S BARCNT=BARCNT+1

 S BARVALUE=$P($T(@2+BARCNT),BARD,2,6)

 Q:BARVALUE="END"

 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 FILE^DICN

 ; ********************************************************************

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

 ; ********************************************************************

MODIFY ; EP

 ; Change PENDING to NON PAYMENT

 S BARD=";;"

 S BARCNT=0

 F  D MODIFY2 Q:BARVALUE="END"

 ; *********************************************************************

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

 ; *********************************************************************

 ; IEN;;NAME;;TABLE TYPE

 ; *********************************************************************

1 ;;

 ;;745;;Premium Pmt Withholding;;21

 ;;746;;Pmt Den DX Invalid for DOS;;4

 ;;747;;Prv Rate Expired/Not on file;;4

 ;;748;;Clm/Srv Rej Info Incomplete;;21

 ;;749;;Lifetime Ben Max for Srv/Ben;;4

 ;;750;;PayAdj No Info for Lgthof Svc;;4

 ;;751;;PayAdj No Info for Lgth of Svc;;4

 ;;752;;PayAdj No Info for Dosage;;4

 ;;753;;PayAdj No Info for Days Supply;;4

 ;;754;;PayAdj No Info for Lvl of Svc;;4

 ;;755;;Clm DEn Pt Refused Srv/Proc;;4

 ;;756;;Flex Spending Accts Payable;;22

 ;;757;;Pmt Den/Red Result Act of War;;4

 ;;758;;Pmt Den/Red Outside US;;4

 ;;759;;Pmt Den/Red Result of Terrorsm;;4

 ;;760;;Pmt Den/Red Activity Ben Excl;;4

 ;;END

 ; ********************************************************************

 ; STND CODE ;; SHORT DESC ;; RPMS CAT ;; RPMS TYP ;; LONG DESC

 ; ********************************************************************

2 ;;

 ;;145;;Premium payment withholding;;21;;745;;Premium payment withholding

 ;;146;;Payment denied because diagnosis invalid for the date(s) of service reported.;;4;;746;;Payment denied because the diagnosis was invalid for the date(s) of service reported.

 ;;147;;Provider contracted/negotiated rate expired or not on file.;;4;;747;;Provider contracted/negotiated rate expired or not on file.

 ;;148;;Clm/Srvc rejectd at this time-info from another prv not provided/insuff/incmplet;;21;;748;;Claim/service rejected at this time because information from another provider was not provided or was insufficient/incomplete.

 ;;149;;Lifetime benefit maximum has been reached for this service/benefit category.;;4;;749;;Lifetime benefit maximum has been reached for this service/benefit category.

 ;;150;;Pmt adjusted - payer deems the info submitted not support this level of service.;;4;;750;;Payment adjusted because the payer deems the information submitted does not support this level of service.

 ;;151;;Pmt adjusted - payer deems the info submitted not support this many svcs.;;4;;751;;Payment adjusted because the payer deems the information submitted does not support this many svcs.

 ;;152;;Pmt adjusted - payer deems the info submitted not support this lgth of svc.;;4;;752;;Payment adjusted because the payer deems the information submitted does not support this length of service.

 ;;153;;Pmt adjusted - payer deems the info submitted not support this dosage.;;4;;753;;Payment adjusted because the payer deems the information submitted does not support this dosage.

 ;;154;;Pmt adjusted - payer deems the info submitted not support this day's supply.;;4;;754;;Payment adjusted because the payer deems the information submitted does not support this day's supply.

 ;;155;;This claim is denied because the patient refused the service/procedure;;4;;755;;This claim is denied because the patient refused the service/procedure

 ;;156;;Flexible spending account payments.;;22;;756;;Flexible spending account payments.

 ;;157;;Pmt denied/reduced - service/procedure provided as a result of an act of war.;;4;;757;;Payment denied/reduced because service/procedure was provided as a result of an act of war.

 ;;158;;Pmt denied/reduced - service/procedure provided outside the United States.;;4;;758;;Payment denied/reduced because service/procedure was provided outside the United States.

 ;;159;;Pmt denied/reduced - service/procedure provided as a result of terrorism.;;4;;759;;Payment denied/reduced because service/procedure was provided as a result of terrorism.

 ;;160;;Pmt denied/reduce - injury/illness result of activity that's a benefit exclusion;;4;;760;;Payment denied/reduced because injury/illness was the result of an activity that is a benefit exclusion.

 ;;END

 ; ********************************************************************

 ; CLAIM STATUS CODE ;; DESCRIPTION

 ; ********************************************************************

3 ;;

 ;;489;;Attachment Control Number

 ;;490;;Other Procedure Code for Service(s) Rendered

 ;;491;;Entity not eligible for encounter submission

 ;;492;;Other Procedure Date

 ;;493;;Version/Release/Industry ID code not currently supported by information holder

 ;;494;;Real-time requests not supported by the information holder, resubmit as batch request

 ;;495;;Requests for re-adjudication must reference the newly assigned payer claim control number for this previously adjusted claim.  Correct the payer claim control number and re-submit.

 ;;END

 ; ********************************************************************

 ; STANDARD CODE ;; RPMS REASON

 ; ********************************************************************

4 ;;

 ;;4;;604

 ;;5;;605

 ;;6;;606

 ;;7;;607

 ;;8;;608

 ;;9;;609

 ;;10;;610

 ;;11;;611

 ;;12;;612

 ;;13;;613

 ;;14;;614

 ;;15;;615

 ;;16;;616

 ;;17;;617

 ;;19;;619

 ;;20;;620

 ;;21;;621

 ;;22;;622

 ;;47;;647

 ;;55;;655

 ;;56;;656

 ;;57;;657

 ;;58;;658

 ;;61;;661

 ;;63;;663

 ;;65;;665

 ;;107;;707

 ;;110;;710

 ;;125;;725

 ;;140;;740

 ;;148;;748

 ;;B12;;862

 ;;B13;;863

 ;;B16;;866

 ;;B18;;868

 ;;B22;;872

 ;;B23;;873

 ;;D1;;901

 ;;D2;;902

 ;;D3;;903

 ;;D4;;904

 ;;D5;;905

 ;;D6;;906

 ;;D7;;907

 ;;D8;;908

 ;;D9;;909

 ;;D10;;910

 ;;D11;;911

 ;;D12;;912

 ;;D13;;913

 ;;D14;;914

 ;;END;;END

BARADJR2  ; IHS/SD/LSL - CREATE ENTRY IN A/R EDI STND CLAIM ADJ REASON ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/LSL - 11/06/03 - V1.7 Patch 4 - routine created

 +4       ;     For HIPAA compliance.  Ceate new entries in A/R EDI STND ADJ

 +5       ;     REASON CODES for new codes added since 6/02.  Also create new

 +6       ;     RPMS reason codes for the standard codes to map to.

 +7       ;

 +8       ; *********************************************************************

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        FOR

               DO RPMSREA2

               IF BARVALUE="END"

                   QUIT

 +5        QUIT

 +6       ; ********************************************************************

 +7       ;

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 FILE^DICN

 +12       QUIT

 +13      ; ********************************************************************

 +14      ; ********************************************************************

 +15      ;

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       ; ********************************************************************

 +7       ;

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      ; ********************************************************************

 +11      ; ********************************************************************

 +12      ;

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        FOR

               DO STND2

               IF BARVALUE="END"

                   QUIT

 +6        QUIT

 +7       ; ********************************************************************

 +8       ;

STND2     ;

 +1        SET BARCNT=BARCNT+1

 +2        SET BARVALUE=$PIECE($TEXT(@2+BARCNT),BARD,2,6)

 +3        IF BARVALUE="END"

               QUIT

 +4        KILL DIC,DA,X,Y

 +5        SET DIC="^BARADJ("

 +6        SET DIC(0)="LZE"

 +7       ; Stnd Code

           SET X=$PIECE(BARVALUE,BARD)

 +8       ; Short Desc

           SET DIC("DR")=".02///^S X=$P(BARVALUE,BARD,2)"

 +9       ; RPMS Cat

           SET DIC("DR")=DIC("DR")_";.03////^S X=$P(BARVALUE,BARD,3)"

 +10      ; RPMS Type

           SET DIC("DR")=DIC("DR")_";.04////^S X=$P(BARVALUE,BARD,4)"

 +11      ; Long Desc

           SET DIC("DR")=DIC("DR")_";101///^S X=$P(BARVALUE,BARD,5)"

 +12       KILL DD,DO

 +13       DO FILE^DICN

 +14       QUIT

 +15      ; ********************************************************************

 +16      ; ********************************************************************

 +17      ;

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       ; ********************************************************************

 +9       ;

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      ; ********************************************************************

 +13      ;

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      ; ********************************************************************

 +15      ; ********************************************************************

 +16      ;

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       ; *********************************************************************

 +7       ;

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         ;;

 +1       ;;745;;Premium Pmt Withholding;;21

 +2       ;;746;;Pmt Den DX Invalid for DOS;;4

 +3       ;;747;;Prv Rate Expired/Not on file;;4

 +4       ;;748;;Clm/Srv Rej Info Incomplete;;21

 +5       ;;749;;Lifetime Ben Max for Srv/Ben;;4

 +6       ;;750;;PayAdj No Info for Lgthof Svc;;4

 +7       ;;751;;PayAdj No Info for Lgth of Svc;;4

 +8       ;;752;;PayAdj No Info for Dosage;;4

 +9       ;;753;;PayAdj No Info for Days Supply;;4

 +10      ;;754;;PayAdj No Info for Lvl of Svc;;4

 +11      ;;755;;Clm DEn Pt Refused Srv/Proc;;4

 +12      ;;756;;Flex Spending Accts Payable;;22

 +13      ;;757;;Pmt Den/Red Result Act of War;;4

 +14      ;;758;;Pmt Den/Red Outside US;;4

 +15      ;;759;;Pmt Den/Red Result of Terrorsm;;4

 +16      ;;760;;Pmt Den/Red Activity Ben Excl;;4

 +17      ;;END

 +18      ;

 +19      ; ********************************************************************

 +20      ; STND CODE ;; SHORT DESC ;; RPMS CAT ;; RPMS TYP ;; LONG DESC

 +21      ; ********************************************************************

2         ;;

 +1       ;;145;;Premium payment withholding;;21;;745;;Premium payment withholding

 +2       ;;146;;Payment denied because diagnosis invalid for the date(s) of service reported.;;4;;746;;Payment denied because the diagnosis was invalid for the date(s) of service reported.

 +3       ;;147;;Provider contracted/negotiated rate expired or not on file.;;4;;747;;Provider contracted/negotiated rate expired or not on file.

 +4       ;;148;;Clm/Srvc rejectd at this time-info from another prv not provided/insuff/incmplet;;21;;748;;Claim/service rejected at this time because information from another provider was not provided or was insufficient/incomplete.

 +5       ;;149;;Lifetime benefit maximum has been reached for this service/benefit category.;;4;;749;;Lifetime benefit maximum has been reached for this service/benefit category.

 +6       ;;150;;Pmt adjusted - payer deems the info submitted not support this level of service.;;4;;750;;Payment adjusted because the payer deems the information submitted does not support this level of service.

 +7       ;;151;;Pmt adjusted - payer deems the info submitted not support this many svcs.;;4;;751;;Payment adjusted because the payer deems the information submitted does not support this many svcs.

 +8       ;;152;;Pmt adjusted - payer deems the info submitted not support this lgth of svc.;;4;;752;;Payment adjusted because the payer deems the information submitted does not support this length of service.

 +9       ;;153;;Pmt adjusted - payer deems the info submitted not support this dosage.;;4;;753;;Payment adjusted because the payer deems the information submitted does not support this dosage.

 +10      ;;154;;Pmt adjusted - payer deems the info submitted not support this day's supply.;;4;;754;;Payment adjusted because the payer deems the information submitted does not support this day's supply.

 +11      ;;155;;This claim is denied because the patient refused the service/procedure;;4;;755;;This claim is denied because the patient refused the service/procedure

 +12      ;;156;;Flexible spending account payments.;;22;;756;;Flexible spending account payments.

 +13      ;;157;;Pmt denied/reduced - service/procedure provided as a result of an act of war.;;4;;757;;Payment denied/reduced because service/procedure was provided as a result of an act of war.

 +14      ;;158;;Pmt denied/reduced - service/procedure provided outside the United States.;;4;;758;;Payment denied/reduced because service/procedure was provided outside the United States.

 +15      ;;159;;Pmt denied/reduced - service/procedure provided as a result of terrorism.;;4;;759;;Payment denied/reduced because service/procedure was provided as a result of terrorism.

 +16      ;;160;;Pmt denied/reduce - injury/illness result of activity that's a benefit exclusion;;4;;760;;Payment denied/reduced because injury/illness was the result of an activity that is a benefit exclusion.

 +17      ;;END

 +18      ;

 +19      ; ********************************************************************

 +20      ; CLAIM STATUS CODE ;; DESCRIPTION

 +21      ; ********************************************************************

3         ;;

 +1       ;;489;;Attachment Control Number

 +2       ;;490;;Other Procedure Code for Service(s) Rendered

 +3       ;;491;;Entity not eligible for encounter submission

 +4       ;;492;;Other Procedure Date

 +5       ;;493;;Version/Release/Industry ID code not currently supported by information holder

 +6       ;;494;;Real-time requests not supported by the information holder, resubmit as batch request

 +7       ;;495;;Requests for re-adjudication must reference the newly assigned payer claim control number for this previously adjusted claim.  Correct the payer claim control number and re-submit.

 +8       ;;END

 +9       ;

 +10      ; ********************************************************************

 +11      ; STANDARD CODE ;; RPMS REASON

 +12      ; ********************************************************************

4         ;;

 +1       ;;4;;604

 +2       ;;5;;605

 +3       ;;6;;606

 +4       ;;7;;607

 +5       ;;8;;608

 +6       ;;9;;609

 +7       ;;10;;610

 +8       ;;11;;611

 +9       ;;12;;612

 +10      ;;13;;613

 +11      ;;14;;614

 +12      ;;15;;615

 +13      ;;16;;616

 +14      ;;17;;617

 +15      ;;19;;619

 +16      ;;20;;620

 +17      ;;21;;621

 +18      ;;22;;622

 +19      ;;47;;647

 +20      ;;55;;655

 +21      ;;56;;656

 +22      ;;57;;657

 +23      ;;58;;658

 +24      ;;61;;661

 +25      ;;63;;663

 +26      ;;65;;665

 +27      ;;107;;707

 +28      ;;110;;710

 +29      ;;125;;725

 +30      ;;140;;740

 +31      ;;148;;748

 +32      ;;B12;;862

 +33      ;;B13;;863

 +34      ;;B16;;866

 +35      ;;B18;;868

 +36      ;;B22;;872

 +37      ;;B23;;873

 +38      ;;D1;;901

 +39      ;;D2;;902

 +40      ;;D3;;903

 +41      ;;D4;;904

 +42      ;;D5;;905

 +43      ;;D6;;906

 +44      ;;D7;;907

 +45      ;;D8;;908

 +46      ;;D9;;909

 +47      ;;D10;;910

 +48      ;;D11;;911

 +49      ;;D12;;912

 +50      ;;D13;;913

 +51      ;;D14;;914

 +52      ;;END;;END

BARADJR2.m