Routine: BARPRFU

BARPRFU ; IHS/SD/LSL - REFUND TRANSACTION EXECUTION ; 04/29/2008

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

 ;** posting utilities

 ; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA

 ;     Don't allow updating of other files if Adjustment Category

 ;     is PENDING or GENERAL INFORMATION

 ; IHS/SD/LSL - 11/26/02 - V1.7- QAA-1200-130051

 ;     Modified to quit if error in creating a new transaction

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

AMT(X,BARMIN,BARMAX) ;EP - ** number function

 ;** quits with "^" to exit

 ;** quits with "?" for incorrect entry

 I '$D(X) Q "^"

 I X["^"!('$L(X)) Q "^"

 S:X["$" X=$P(X,"$",2)

 I X'?."-".N.1".".2N Q "?"

 I $D(BARMIN),X'>BARMIN Q "?"

 I $D(BARMAX),X'<BARMAX Q "?"

Q X

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

COMHLP ;EP - help processor

 N X,J

 W $$EN^BARVDF("IOF"),!!

 S X="Select Command Options"

 W ?IOM-$L(X)\2,X

 W !?IOM-$L(X)\2 F J=1:1:$L(X) W "-"

 W !!

 D:$D(BARHLP)<10 SETHLP

 S J=""

 F  S J=$O(BARHLP(J)) Q:J=""  W !?2,BARHLP(J)

 W !!

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

SETHLP ;EP - sethelp

 S BARHLP("A")="A = Adjustments (Write-Off, Deductible, Non-Covered, Non-Pay, Penalty)"

 S BARHLP("D")="D = Patient Demographics"

 S BARHLP("E")="E = Edit a transaction not yet posted to A/R"

B S BARHLP("B")="B = Bill Inquire"

 S BARHLP("I")="I = Insurer Demographics"

 S BARHLP("H")="H = History of Bill Transactions ($ only)"

 S BARHLP("M")="M = Message"

 S BARHLP("Q")="Q = Quit - Ends the data entry for this Patient and allows for posting to A/R"

 S BARHLP("R")="R = Refund"

 S BARHLP("T")="T = Toggle Display - Current transaction list."

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

POSTTX ;EP - poster;  ;NO LONGER USED, CALL IS TO POSTTX^BARPSTU ;BAR*1.8*4 DD 4.1.7.2

 W !!,"Please wait... Posting Transactions."

 K DD,DO,BARBLV

 N DA,DR,DIE,DIC,DIQ

 S BARLIN=0

 F  S BARLIN=$O(BARTR(BARLIN)) Q:'BARLIN  D

 .S BARBDFN=$O(^BARTMP($J,"B",BARLIN,""))

 .S BARROLL(BARBDFN)=""

 .S BARAC=$$GET1^DIQ(90050.01,BARBDFN,3,"I")

 .S BARBLV(15)=$$GET1^DIQ(90050.01,BARBDFN,15,"I")

 .D CKBAL^BARPSTU(BARLIN,BARBLV(15))     ;BAR*1.8*4 DD 4.1.7.2

 .Q:BARSTOP                              ;BAR*1.8*4 DD 4.1.7.2

 .S (BARBTOT,BARJ)=0

 .F  S BARJ=$O(BARTR(BARLIN,BARJ)) Q:'BARJ  D

 ..S BARREC=BARTR(BARLIN,BARJ)

 ..S BARTXT=$P(BARREC,U,1)

 ..S BARAMT=$P(BARREC,U,2)

 ..S BARBTOT=BARBTOT+BARAMT

 ..S BARCAT=$P(BARREC,U,3)

 ..S:BARTXT="A" BARTT=$O(^BARTBL("B","ADJUST ACCOUNT",""))

 ..S:BARTXT="R" BARTT=39

 ..;change from 55 wrong account number

 ..S BARATYP=$P(BARREC,U,4)

 ..D P1

 .K ^BARTMP($J,BARDA)             ;BAR*1.8*4 DD 4.1.7.2

 .K BARTR(BARLIN),BARREF,BARADJ,BARCAT,BARATYP,BARBTOT,BARBLV  ;BAR*1.8*4 DD 4.1.7.2

 ;K ^BARTMP($J)                   ;BAR*1.8*4 DD 4.1.7.2

 ;K BARTR,BARREF,BARADJ,BARCAT,BARATYP,BARBTOT,BARBLV   ;BAR*1.8*4 DD 4.1.7.2

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

P1 ;

 S DIC="^BARTR(DUZ(2),"

 S DIC(0)="L"

 S BARCR=$S(+BARAMT>0:BARAMT,1:"")

 S BARDB=$S(+BARAMT<0:BARAMT,1:"")

 S BARDB=-BARDB

 S BARPT=+BARPAT

 S BARPAR=""

 S BARASFAC=""

 S BARSECT=""

 S BARSITE=""

PX ;

 S X=$$NEW^BARTR

 S BARTRIEN=X

 I X<1 D MSG^BARTR(BARBDFN) Q

 K DIE,DIC,DA,DR

 S DA=X

 S DIE=90050.03

 S DR="2////^S X=BARCR"

 S DR=DR_";3////^S X=BARDB"

 S DR=DR_";4////^S X=BARBDFN"

 S DR=DR_";5////^S X=BARPT"

 S DR=DR_";6////^S X=BARAC"

 S DR=DR_";8////^S X=BARPAR"

 S DR=DR_";9////^S X=BARASFAC"

 S DR=DR_";10////^S X=BARSECT"

 S DR=DR_";11////^S X=BARSITE"

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

 S DR=DR_";13////^S X=DUZ"

 S DR=DR_";101////^S X=BARTT"

 S DR=DR_";102////^S X=BARCAT"

 S DR=DR_";103////^S X=BARATYP"

 S DR=DR_";10////^S X=$$VALI^XBDIQ1(200,DUZ,29)"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 I ",21,22,"[(","_BARCAT_",") Q

 D TR^BARTDO(BARTRIEN)

 W "."

DONE ;

BARPRFU   ; IHS/SD/LSL - REFUND TRANSACTION EXECUTION ; 04/29/2008

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

 +2       ;** posting utilities

 +3       ;

 +4       ; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA

 +5       ;     Don't allow updating of other files if Adjustment Category

 +6       ;     is PENDING or GENERAL INFORMATION

 +7       ;

 +8       ; IHS/SD/LSL - 11/26/02 - V1.7- QAA-1200-130051

 +9       ;     Modified to quit if error in creating a new transaction

 +10      ;

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

 +12       QUIT

 +13      ;

AMT(X,BARMIN,BARMAX) ;EP - ** number function

 +1       ;** quits with "^" to exit

 +2       ;** quits with "?" for incorrect entry

 +3        IF '$DATA(X)

               QUIT "^"

 +4        IF X["^"!('$LENGTH(X))

               QUIT "^"

 +5        IF X["$"

               SET X=$PIECE(X,"$",2)

 +6        IF X'?."-".N.1".".2N

               QUIT "?"

 +7        IF $DATA(BARMIN)

               IF X'>BARMIN

                   QUIT "?"

 +8        IF $DATA(BARMAX)

               IF X'<BARMAX

                   QUIT "?"

 +9        QUIT X

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

 +11      ;

COMHLP    ;EP - help processor

 +1        NEW X,J

 +2        WRITE $$EN^BARVDF("IOF"),!!

 +3        SET X="Select Command Options"

 +4        WRITE ?IOM-$LENGTH(X)\2,X

 +5        WRITE !?IOM-$LENGTH(X)\2

           FOR J=1:1:$LENGTH(X)

               WRITE "-"

 +6        WRITE !!

 +7        IF $DATA(BARHLP)<10

               DO SETHLP

 +8        SET J=""

 +9        FOR

               SET J=$ORDER(BARHLP(J))

               IF J=""

                   QUIT

               WRITE !?2,BARHLP(J)

 +10       WRITE !!

 +11       QUIT

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

 +13      ;

SETHLP    ;EP - sethelp

 +1        SET BARHLP("A")="A = Adjustments (Write-Off, Deductible, Non-Covered, Non-Pay, Penalty)"

 +2        SET BARHLP("D")="D = Patient Demographics"

 +3        SET BARHLP("E")="E = Edit a transaction not yet posted to A/R"

B          SET BARHLP("B")="B = Bill Inquire"

 +1        SET BARHLP("I")="I = Insurer Demographics"

 +2        SET BARHLP("H")="H = History of Bill Transactions ($ only)"

 +3        SET BARHLP("M")="M = Message"

 +4        SET BARHLP("Q")="Q = Quit - Ends the data entry for this Patient and allows for posting to A/R"

 +5        SET BARHLP("R")="R = Refund"

 +6        SET BARHLP("T")="T = Toggle Display - Current transaction list."

 +7        QUIT

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

 +9       ;

POSTTX    ;EP - poster;  ;NO LONGER USED, CALL IS TO POSTTX^BARPSTU ;BAR*1.8*4 DD 4.1.7.2

 +1        QUIT

 +2        WRITE !!,"Please wait... Posting Transactions."

 +3        KILL DD,DO,BARBLV

 +4        NEW DA,DR,DIE,DIC,DIQ

 +5        SET BARLIN=0

 +6        FOR

               SET BARLIN=$ORDER(BARTR(BARLIN))

               IF 'BARLIN

                   QUIT

               Begin DoDot:1

 +7                SET BARBDFN=$ORDER(^BARTMP($JOB,"B",BARLIN,""))

 +8                SET BARROLL(BARBDFN)=""

 +9                SET BARAC=$$GET1^DIQ(90050.01,BARBDFN,3,"I")

 +10               SET BARBLV(15)=$$GET1^DIQ(90050.01,BARBDFN,15,"I")

 +11      ;BAR*1.8*4 DD 4.1.7.2

                   DO CKBAL^BARPSTU(BARLIN,BARBLV(15))

 +12      ;BAR*1.8*4 DD 4.1.7.2

                   IF BARSTOP

                       QUIT

 +13               SET (BARBTOT,BARJ)=0

 +14               FOR

                       SET BARJ=$ORDER(BARTR(BARLIN,BARJ))

                       IF 'BARJ

                           QUIT

                       Begin DoDot:2

 +15                       SET BARREC=BARTR(BARLIN,BARJ)

 +16                       SET BARTXT=$PIECE(BARREC,U,1)

 +17                       SET BARAMT=$PIECE(BARREC,U,2)

 +18                       SET BARBTOT=BARBTOT+BARAMT

 +19                       SET BARCAT=$PIECE(BARREC,U,3)

 +20                       IF BARTXT="A"

                               SET BARTT=$ORDER(^BARTBL("B","ADJUST ACCOUNT",""))

 +21                       IF BARTXT="R"

                               SET BARTT=39

 +22      ;change from 55 wrong account number

 +23                       SET BARATYP=$PIECE(BARREC,U,4)

 +24                       DO P1

                       End DoDot:2

 +25      ;BAR*1.8*4 DD 4.1.7.2

                   KILL ^BARTMP($JOB,BARDA)

 +26      ;BAR*1.8*4 DD 4.1.7.2

                   KILL BARTR(BARLIN),BARREF,BARADJ,BARCAT,BARATYP,BARBTOT,BARBLV

               End DoDot:1

 +27      ;K ^BARTMP($J)                   ;BAR*1.8*4 DD 4.1.7.2

 +28      ;K BARTR,BARREF,BARADJ,BARCAT,BARATYP,BARBTOT,BARBLV   ;BAR*1.8*4 DD 4.1.7.2

 +29       QUIT

 +30      ; *********************************************************************

 +31      ;

P1        ;

 +1        SET DIC="^BARTR(DUZ(2),"

 +2        SET DIC(0)="L"

 +3        SET BARCR=$SELECT(+BARAMT>0:BARAMT,1:"")

 +4        SET BARDB=$SELECT(+BARAMT<0:BARAMT,1:"")

 +5        SET BARDB=-BARDB

 +6        SET BARPT=+BARPAT

 +7        SET BARPAR=""

 +8        SET BARASFAC=""

 +9        SET BARSECT=""

 +10       SET BARSITE=""

PX        ;

 +1        SET X=$$NEW^BARTR

 +2        SET BARTRIEN=X

 +3        IF X<1

               DO MSG^BARTR(BARBDFN)

               QUIT

 +4        KILL DIE,DIC,DA,DR

 +5        SET DA=X

 +6        SET DIE=90050.03

 +7        SET DR="2////^S X=BARCR"

 +8        SET DR=DR_";3////^S X=BARDB"

 +9        SET DR=DR_";4////^S X=BARBDFN"

 +10       SET DR=DR_";5////^S X=BARPT"

 +11       SET DR=DR_";6////^S X=BARAC"

 +12       SET DR=DR_";8////^S X=BARPAR"

 +13       SET DR=DR_";9////^S X=BARASFAC"

 +14       SET DR=DR_";10////^S X=BARSECT"

 +15       SET DR=DR_";11////^S X=BARSITE"

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

 +17       SET DR=DR_";13////^S X=DUZ"

 +18       SET DR=DR_";101////^S X=BARTT"

 +19       SET DR=DR_";102////^S X=BARCAT"

 +20       SET DR=DR_";103////^S X=BARATYP"

 +21       SET DR=DR_";10////^S X=$$VALI^XBDIQ1(200,DUZ,29)"

 +22       SET DIDEL=90050

 +23       DO ^DIE

 +24       KILL DIDEL

 +25       IF ",21,22,"[(","_BARCAT_",")

               QUIT

 +26       DO TR^BARTDO(BARTRIEN)

 +27       WRITE "."

DONE      ;

 +1        QUIT

BARPRFU.m