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
;
; ********************************************************************
Q
;
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 !!
Q
; *********************************************************************
;
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."
Q
; *********************************************************************
;
POSTTX ;EP - poster; ;NO LONGER USED, CALL IS TO POSTTX^BARPSTU ;BAR*1.8*4 DD 4.1.7.2
Q
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
Q
; *********************************************************************
;
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 ;
Q
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
