BARFRAPI.m

BARFRAPI ; IHS/SD/LSL - A/R Flat Rate API ;

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

 ;

 ; IHS/SD/SDR - BAR*1.6*3 - 9/16/2002 - QDA-0802-130076

 ;         Modified routine to populate current balance correctly

 ;         Also added a line to new DA so it doesn't get overwritten

 ;         for 3PB routine

 ;

 Q

 ;

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

EN(BAR)         ; PEP

 ; API to pass Flat Rate Adjustments from 3PB to A/R

 ; This API is expecting the difference between what the Flat Rate was

 ; and what the new rate is.  A transaction will be created for the

 ; difference with a transaction type of FRA.  The amount billed and

 ; current bill amount will be adjusted accordingly.

 ;

 ; Pass in array where:

 ;     BAR("USER")         User who enters transaction

 ;     BAR("ADJ AMT")      Dollar amount of transaction

 ;     BAR("ARLOC")        Location of A/R bill DUZ(2),IEN

 ;     BAR("TRAN TYPE")    Type of transaction to post

 ;

 ; -------------------------------

 ;

 N DA

 I '$G(BAR("ADJ AMT"))!('$G(BAR("ARLOC")))!('$G(BAR("TRAN TYPE"))) Q ""

 I $G(BAR("TRAN TYPE"))'=503 Q "NOT FRA TRANSACTION TYPE"

 I '+BAR("ADJ AMT") Q "NO AMOUNT ENTERED"

 ;

 ; Set BARUSR(29,"I") to accomodate input transforms on many A/R fields.

 ; This value must match the Service section on the transaction.

 ; Service/Section must be Business Office (8) for A/R

 ;

 S BARUSR(29,"I")=8

 S BARHOLD=DUZ(2)

 S DUZ(2)=+BAR("ARLOC")

 S BARBLIEN=$P(BAR("ARLOC"),",",2)

 I 'BARBLIEN Q "No A/R bill to post to"

 ;

 S BARBLPAT=$$GET1^DIQ(90050.01,BARBLIEN,101,"I")  ; A/R Patient IEN

 S BARBLAC=$$GET1^DIQ(90050.01,BARBLIEN,3,"I")     ; A/R Account

 S BARVIST=$$GET1^DIQ(90050.01,BARBLIEN,108,"I")   ; A/R Visit loc

 S BARTRIEN=$$NEW^BARTR                      ; Create New Transaction

 I +BARTRIEN<1 Q "A/R TRANSACTION NOT CREATED"

 ;

 ; Populate Transaction file

 S DA=BARTRIEN                               ; IEN to A/R TRANSACTION

 S DIE=90050.03

 I $E(BAR("ADJ AMT"),1)="-" S DR="2////^S X=BAR(""ADJ AMT"")"  ; Credit

 E  S DR="3////^S X=BAR(""ADJ AMT"")"  ; Debit

 S DR=DR_";4////^S X=BARBLIEN"               ; A/R Bill

 S DR=DR_";5////^S X=BARBLPAT"               ; A/R Patient

 S DR=DR_";6////^S X=BARBLAC"                ; A/R Account

 S DR=DR_";8////^S X=DUZ(2)"                 ; Parent Location

 S DR=DR_";9////^S X=DUZ(2)"                 ; Parent ASUFAC

 ;

 ; Force A/R section to Business Office

 S DR=DR_";10////8"                          ; A/R Section

 S DR=DR_";11////^S X=BARVIST"               ; Visit Location

 S DR=DR_";12////^S X=DT"                    ; Date

 S DR=DR_";13////^S X=BAR(""USER"")"         ; Entry by

 S DR=DR_";101////^S X=BAR(""TRAN TYPE"")"   ; Transaction Type

 S DIDEL=90050

 D ^DIE

 K DIDEL,DIE,DA,DR

 ;

 ; Adjust bill amount and current bill amount to reflect difference

 S BARBAMT=$P($G(^BARBL(DUZ(2),BARBLIEN,0)),U,13)  ;amount billed

 S BARCBAMT=$P($G(^BARBL(DUZ(2),BARBLIEN,0)),U,15)  ;current bill amount

 S DR="13////^S X=BARBAMT+BAR(""ADJ AMT"")"  ;adjust amount billed

 S DR=DR_";15////^S X=BARCBAMT+BAR(""ADJ AMT"")"  ;adj current bill amt

 S DIE=90050.01   ;A/R bill file

 S DA=BARBLIEN

 D ^DIE

 ;

 ; Post from transaction file to related files

 D TR^BARTDO(BARTRIEN)                 ;Pull trans info and update PSR

 S DUZ(2)=BARHOLD

 Q BAR("ARLOC")

BARFRAPI  ; IHS/SD/LSL - A/R Flat Rate API ;

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

 +2       ;

 +3       ; IHS/SD/SDR - BAR*1.6*3 - 9/16/2002 - QDA-0802-130076

 +4       ;         Modified routine to populate current balance correctly

 +5       ;         Also added a line to new DA so it doesn't get overwritten

 +6       ;         for 3PB routine

 +7       ;

 +8        QUIT 

 +9       ;

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

EN(BAR)   ; PEP

 +1       ; API to pass Flat Rate Adjustments from 3PB to A/R

 +2       ; This API is expecting the difference between what the Flat Rate was

 +3       ; and what the new rate is.  A transaction will be created for the

 +4       ; difference with a transaction type of FRA.  The amount billed and

 +5       ; current bill amount will be adjusted accordingly.

 +6       ;

 +7       ; Pass in array where:

 +8       ;     BAR("USER")         User who enters transaction

 +9       ;     BAR("ADJ AMT")      Dollar amount of transaction

 +10      ;     BAR("ARLOC")        Location of A/R bill DUZ(2),IEN

 +11      ;     BAR("TRAN TYPE")    Type of transaction to post

 +12      ;

 +13      ; -------------------------------

 +14      ;

 +15       NEW DA

 +16       IF '$GET(BAR("ADJ AMT"))!('$GET(BAR("ARLOC")))!('$GET(BAR("TRAN TYPE")))

               QUIT ""

 +17       IF $GET(BAR("TRAN TYPE"))'=503

               QUIT "NOT FRA TRANSACTION TYPE"

 +18       IF '+BAR("ADJ AMT")

               QUIT "NO AMOUNT ENTERED"

 +19      ;

 +20      ; Set BARUSR(29,"I") to accomodate input transforms on many A/R fields.

 +21      ; This value must match the Service section on the transaction.

 +22      ; Service/Section must be Business Office (8) for A/R

 +23      ;

 +24       SET BARUSR(29,"I")=8

 +25       SET BARHOLD=DUZ(2)

 +26       SET DUZ(2)=+BAR("ARLOC")

 +27       SET BARBLIEN=$PIECE(BAR("ARLOC"),",",2)

 +28       IF 'BARBLIEN

               QUIT "No A/R bill to post to"

 +29      ;

 +30      ; A/R Patient IEN

           SET BARBLPAT=$$GET1^DIQ(90050.01,BARBLIEN,101,"I")

 +31      ; A/R Account

           SET BARBLAC=$$GET1^DIQ(90050.01,BARBLIEN,3,"I")

 +32      ; A/R Visit loc

           SET BARVIST=$$GET1^DIQ(90050.01,BARBLIEN,108,"I")

 +33      ; Create New Transaction

           SET BARTRIEN=$$NEW^BARTR

 +34       IF +BARTRIEN<1

               QUIT "A/R TRANSACTION NOT CREATED"

 +35      ;

 +36      ; Populate Transaction file

 +37      ; IEN to A/R TRANSACTION

           SET DA=BARTRIEN

 +38       SET DIE=90050.03

 +39      ; Credit

           IF $EXTRACT(BAR("ADJ AMT"),1)="-"

               SET DR="2////^S X=BAR(""ADJ AMT"")"

 +40      ; Debit

          IF '$TEST

               SET DR="3////^S X=BAR(""ADJ AMT"")"

 +41      ; A/R Bill

           SET DR=DR_";4////^S X=BARBLIEN"

 +42      ; A/R Patient

           SET DR=DR_";5////^S X=BARBLPAT"

 +43      ; A/R Account

           SET DR=DR_";6////^S X=BARBLAC"

 +44      ; Parent Location

           SET DR=DR_";8////^S X=DUZ(2)"

 +45      ; Parent ASUFAC

           SET DR=DR_";9////^S X=DUZ(2)"

 +46      ;

 +47      ; Force A/R section to Business Office

 +48      ; A/R Section

           SET DR=DR_";10////8"

 +49      ; Visit Location

           SET DR=DR_";11////^S X=BARVIST"

 +50      ; Date

           SET DR=DR_";12////^S X=DT"

 +51      ; Entry by

           SET DR=DR_";13////^S X=BAR(""USER"")"

 +52      ; Transaction Type

           SET DR=DR_";101////^S X=BAR(""TRAN TYPE"")"

 +53       SET DIDEL=90050

 +54       DO ^DIE

 +55       KILL DIDEL,DIE,DA,DR

 +56      ;

 +57      ; Adjust bill amount and current bill amount to reflect difference

 +58      ;amount billed

           SET BARBAMT=$PIECE($GET(^BARBL(DUZ(2),BARBLIEN,0)),U,13)

 +59      ;current bill amount

           SET BARCBAMT=$PIECE($GET(^BARBL(DUZ(2),BARBLIEN,0)),U,15)

 +60      ;adjust amount billed

           SET DR="13////^S X=BARBAMT+BAR(""ADJ AMT"")"

 +61      ;adj current bill amt

           SET DR=DR_";15////^S X=BARCBAMT+BAR(""ADJ AMT"")"

 +62      ;A/R bill file

           SET DIE=90050.01

 +63       SET DA=BARBLIEN

 +64       DO ^DIE

 +65      ;

 +66      ; Post from transaction file to related files

 +67      ;Pull trans info and update PSR

           DO TR^BARTDO(BARTRIEN)

 +68       SET DUZ(2)=BARHOLD

 +69       QUIT BAR("ARLOC")