BARPSAPI.m

BARPSAPI ; IHS/SD/LSL - A/R Pharmacy POS API ;

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

 ;

 Q

 ;

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

EN(BAR)         ; PEP

 Q "API DISABLED"  ;BAR*1.8*4 ITEM 5 SCR58

 ; Pass in array where

 ; BAR("USER")            User who enters transaction

 ; BAR("CREDIT")          Dollar amount of transaction

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

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

 ; BAR("ADJ CAT")         Adjustment category if BAR("TRAN TYPE")=43

 ; BAR("ADJ TYPE")        Adjustment type if BAR("TRAN TYPE")=43

 ;

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

 I $G(BAR("TRAN TYPE"))=43&('$G(BAR("ADJ CAT"))!('$G(BAR("ADJ TYPE")))) Q ""

 ; 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 BARROLL(BARBLIEN)=""                      ; Needed for rollback

 S BARBLPAT=$$VALI^XBDIQ1(90050.01,BARBLIEN,101)  ; A/R Patient IEN

 S BARBLAC=$$VALI^XBDIQ1(90050.01,BARBLIEN,3)     ; A/R Account

 S BARVIST=$$VALI^XBDIQ1(90050.01,BARBLIEN,108)   ; A/R Visit loc

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

 I +BARTRIEN<1 Q ""

 ; Populate Transaction file

 S DA=BARTRIEN                               ; IEN to A/R TRANSACTION

 S DIE=90050.03

 S DR="2////^S X=BAR(""CREDIT"")"            ; Credit

 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

 I BAR("TRAN TYPE")=43 D                     ; If Adjustment

 . S DR=DR_";102////^S X=BAR(""ADJ CAT"")"   ; Adjustment Category

 . S DR=DR_";103////^S X=BAR(""ADJ TYPE"")"  ; Adjustment Type

 S DIDEL=90050

 D ^DIE

 K DIDEL,DIE,DA,DR

 ; Post from transaction file to related files

 D TR^BARTDO(BARTRIEN)

 D EN^BARROLL                                ; Roll trans back to 3PB

 S DUZ(2)=BARHOLD

 Q BAR("ARLOC")

BARPSAPI  ; IHS/SD/LSL - A/R Pharmacy POS API ;

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

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ; *********************************************************************

EN(BAR)   ; PEP

 +1       ;BAR*1.8*4 ITEM 5 SCR58

           QUIT "API DISABLED"

 +2       ; Pass in array where

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

 +4       ; BAR("CREDIT")          Dollar amount of transaction

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

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

 +7       ; BAR("ADJ CAT")         Adjustment category if BAR("TRAN TYPE")=43

 +8       ; BAR("ADJ TYPE")        Adjustment type if BAR("TRAN TYPE")=43

 +9       ;

 +10       IF '$GET(BAR("CREDIT"))!('$GET(BAR("ARLOC")))!('$GET(BAR("TRAN TYPE")))

               QUIT ""

 +11       IF $GET(BAR("TRAN TYPE"))=43&('$GET(BAR("ADJ CAT"))!('$GET(BAR("ADJ TYPE"))))

               QUIT ""

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

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

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

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

 +16       SET BARHOLD=DUZ(2)

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

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

 +19       IF 'BARBLIEN

               QUIT "No A/R bill to post to"

 +20      ; Needed for rollback

           SET BARROLL(BARBLIEN)=""

 +21      ; A/R Patient IEN

           SET BARBLPAT=$$VALI^XBDIQ1(90050.01,BARBLIEN,101)

 +22      ; A/R Account

           SET BARBLAC=$$VALI^XBDIQ1(90050.01,BARBLIEN,3)

 +23      ; A/R Visit loc

           SET BARVIST=$$VALI^XBDIQ1(90050.01,BARBLIEN,108)

 +24      ; Create New Transaction

           SET BARTRIEN=$$NEW^BARTR

 +25       IF +BARTRIEN<1

               QUIT ""

 +26      ; Populate Transaction file

 +27      ; IEN to A/R TRANSACTION

           SET DA=BARTRIEN

 +28       SET DIE=90050.03

 +29      ; Credit

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

 +30      ; A/R Bill

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

 +31      ; A/R Patient

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

 +32      ; A/R Account

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

 +33      ; Parent Location

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

 +34      ; Parent ASUFAC

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

 +35      ; Force A/R section to Business Office

 +36      ; A/R Section

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

 +37      ; Visit Location

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

 +38      ; Date

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

 +39      ; Entry by

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

 +40      ; Transaction Type

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

 +41      ; If Adjustment

           IF BAR("TRAN TYPE")=43

               Begin DoDot:1

 +42      ; Adjustment Category

                   SET DR=DR_";102////^S X=BAR(""ADJ CAT"")"

 +43      ; Adjustment Type

                   SET DR=DR_";103////^S X=BAR(""ADJ TYPE"")"

               End DoDot:1

 +44       SET DIDEL=90050

 +45       DO ^DIE

 +46       KILL DIDEL,DIE,DA,DR

 +47      ; Post from transaction file to related files

 +48       DO TR^BARTDO(BARTRIEN)

 +49      ; Roll trans back to 3PB

           DO EN^BARROLL

 +50       SET DUZ(2)=BARHOLD

 +51       QUIT BAR("ARLOC")