BARPBEN ; IHS/SD/LSL - AUTO POSTING OF BENEFICIARY ACCOUNTS ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**21,23**;OCT 26, 2005
;;
; IHS/SD/LSL - 04/29/03 - V1.8
; Tweaked code for national release. Original routine AZLKAP01.
; Thanks to California area (7/10/2000)
;
;APR 2012 P.OTTIS TICKET # 66991 CODE FIX: <UNDEF> LOOP+21
; # 64722
; # 57240
; ********************************************************************
Q
;
EN ; EP
; SELECT ACCOUNT
Q:$G(XQUIT)=1 ;IHS/SD/TPF BAR*1.8*21 HEAT43451
D:'$D(BARUSR) INIT^BARUTL ; Setup basic AR var
S BAR("PRIVACY")=1 ; Privacy Act applies
S BAR("LOC")="BILLING" ;Always Billing location
I $D(^XTMP("BAR-BEN")) D Q
. W !!!,"***AUTO POSTING JOB IN PROGRESS ***"
. D EOP^BARUTL(0)
D ASK ; Ask user prompts
Q:'+BARACDA!('$D(BARSBY))
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
S BARQ("RC")="LOOP^BARPBEN"
S BARQ("RP")="PRINT^BARPBEN2"
S BARQ("RX")="POUT^BARRUTL"
S BARQ("NS")="BAR"
D ^BARDBQUE
D PAZ^BARRUTL
Q
; ********************************************************************
;
ASK ;
; Ask AR Account to Auto Post
W !!
S BARACDA=0
K DIC,DA
S DIC="^BARAC(DUZ(2),"
S DIC("A")="Select Beneficiary Account to be Auto-Posted: "
S DIC("S")="N ZZ S ZZ=$$GET1^DIQ(90050.02,+Y,.01) I ZZ[""BENEFIC"",ZZ[""PATIENT"",ZZ'[""NON"""
S DIC(0)="AEQZ"
D ^DIC
Q:Y'>0
S BARACDA=+Y
S BARACNM=Y(0,0)
;
; Is this the Account they really want to Auto post
W !!,"Account selected is ",BARACNM,!
K DIR
S DIR(0)="YO"
S DIR("A")="Is this the proper account"
D ^DIR
K DIR
Q:Y'>0
;
; Are they sure they want to Auto Post said account
W !!,"Proceeding with Auto-Posting of: ",BARACNM,!!
K DIR
S DIR(0)="SOB^P:Patient;B:Bill"
S DIR("A")="Select Report Sorting By:(Patient/Bill) "
S DIR("B")="B"
D ^DIR
K DIR,DIC
I "BP"'[Y Q
S BARSBY=Y
Q
; ********************************************************************
; ********************************************************************
;
LOOP ; EP
; Loop ABAL index
S BARCNT=0,BARTOT=0
D BASIC
S BARDR=DR
;
S ^XTMP("BAR-BEN",$J,0)=DT_U_DT_U_"AUTO POSTING OF BENEFICIARY BILLS LOG"
S BARBLDA=0
F S BARBLDA=$O(^BARBL(DUZ(2),"ABAL",BARACDA,BARBLDA)) Q:'+BARBLDA D
. D GET
. S HAVETRIEN=0 ;P.OTTIS TICKET # 66991
. D POST
. I HAVETRIEN=0 QUIT ;P.OTTIS TICKET # 66991
. Q:BARTRIEN<1
. D LOG
Q
; ********************************************************************
;
BASIC ;EP ASSEMBLE BASIC DATA FOR TRANSACTION
;
S DR="2////^ S X=BARBIL(15)" ; Credit
S DR=DR_";4////^S X=BARBLDA" ; A/R Bill
S DR=DR_";5////^S X=BARBIL(101,""I"")" ; A/R Patient
S DR=DR_";6////^S X=BARBIL(3,""I"")" ; A/R Account
S DR=DR_";8////^S X=DUZ(2)" ; Parent Location
S DR=DR_";9////^S X=DUZ(2)" ; Parent ASUFAC
S DR=DR_";10////^S X=BARBIL(10,""I"")" ; A/R Section
S DR=DR_";11////^S X=BARBIL(108,""I"")" ; Visit Location
S DR=DR_";12////^S X=DT" ; Date
S DR=DR_";13////^S X=DUZ" ; Entry by
S DR=DR_";101////^S X=43" ; Transaction Type
S DR=DR_";102////3" ; Adjust Cat Write Off
S DR=DR_";103////136" ; Adjust type Indian Ben
Q
; ********************************************************************
;
GET ;EP pull data for posting
K BARBL
D ENP^XBDIQ1(90050.01,BARBLDA,".001;.01;3;10;13;15;18;101;102;108","BARBIL(","EI")
I $E(IOST)="C" W "."
Q
; ********************************************************************
;
POST ;EP
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
; SET TRANSACTION & POST FILES
S BARTRIEN=$$NEW^BARTR ; Create Transaction
; Populate Transaction file
I BARTRIEN<1 D MSG^BARTR(BARBLDA) Q
S HAVETRIEN=1 ;P.OTTIS TICKET # 66991
S DA=BARTRIEN ; IEN to A/R TRANSACTION
S DIE=90050.03
S DIDEL=90050
S DR=BARDR
D ^DIE
K DIDEL,DIE,DA,DR
; Post from transaction file to related files
D TR^BARTDO(BARTRIEN)
Q
; ********************************************************************
;
LOG ;EP
; log entry into ^XTMP
I BARSBY="P" S ^XTMP("BAR-BEN",$J,BARBIL(101),BARBIL(.01))=BARBIL(15)_U_BARBIL(102)
I BARSBY="B" S ^XTMP("BAR-BEN",$J,BARBIL(.01))=BARBIL(15)_U_BARBIL(102)_U_BARBIL(101)
S BARTOT=BARTOT+BARBIL(15)
S BARCNT=BARCNT+1
Q
BARPBEN ; IHS/SD/LSL - AUTO POSTING OF BENEFICIARY ACCOUNTS ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**21,23**;OCT 26, 2005
+2 ;;
+3 ; IHS/SD/LSL - 04/29/03 - V1.8
+4 ; Tweaked code for national release. Original routine AZLKAP01.
+5 ; Thanks to California area (7/10/2000)
+6 ;
+7 ;APR 2012 P.OTTIS TICKET # 66991 CODE FIX: <UNDEF> LOOP+21
+8 ; # 64722
+9 ; # 57240
+10 ; ********************************************************************
+11 QUIT
+12 ;
EN ; EP
+1 ; SELECT ACCOUNT
+2 ;IHS/SD/TPF BAR*1.8*21 HEAT43451
IF $GET(XQUIT)=1
QUIT
+3 ; Setup basic AR var
IF '$DATA(BARUSR)
DO INIT^BARUTL
+4 ; Privacy Act applies
SET BAR("PRIVACY")=1
+5 ;Always Billing location
SET BAR("LOC")="BILLING"
+6 IF $DATA(^XTMP("BAR-BEN"))
Begin DoDot:1
+7 WRITE !!!,"***AUTO POSTING JOB IN PROGRESS ***"
+8 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+9 ; Ask user prompts
DO ASK
+10 IF '+BARACDA!('$DATA(BARSBY))
QUIT
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+12 SET BARQ("RC")="LOOP^BARPBEN"
+13 SET BARQ("RP")="PRINT^BARPBEN2"
+14 SET BARQ("RX")="POUT^BARRUTL"
+15 SET BARQ("NS")="BAR"
+16 DO ^BARDBQUE
+17 DO PAZ^BARRUTL
+18 QUIT
+19 ; ********************************************************************
+20 ;
ASK ;
+1 ; Ask AR Account to Auto Post
+2 WRITE !!
+3 SET BARACDA=0
+4 KILL DIC,DA
+5 SET DIC="^BARAC(DUZ(2),"
+6 SET DIC("A")="Select Beneficiary Account to be Auto-Posted: "
+7 SET DIC("S")="N ZZ S ZZ=$$GET1^DIQ(90050.02,+Y,.01) I ZZ[""BENEFIC"",ZZ[""PATIENT"",ZZ'[""NON"""
+8 SET DIC(0)="AEQZ"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET BARACDA=+Y
+12 SET BARACNM=Y(0,0)
+13 ;
+14 ; Is this the Account they really want to Auto post
+15 WRITE !!,"Account selected is ",BARACNM,!
+16 KILL DIR
+17 SET DIR(0)="YO"
+18 SET DIR("A")="Is this the proper account"
+19 DO ^DIR
+20 KILL DIR
+21 IF Y'>0
QUIT
+22 ;
+23 ; Are they sure they want to Auto Post said account
+24 WRITE !!,"Proceeding with Auto-Posting of: ",BARACNM,!!
+25 KILL DIR
+26 SET DIR(0)="SOB^P:Patient;B:Bill"
+27 SET DIR("A")="Select Report Sorting By:(Patient/Bill) "
+28 SET DIR("B")="B"
+29 DO ^DIR
+30 KILL DIR,DIC
+31 IF "BP"'[Y
QUIT
+32 SET BARSBY=Y
+33 QUIT
+34 ; ********************************************************************
+35 ; ********************************************************************
+36 ;
LOOP ; EP
+1 ; Loop ABAL index
+2 SET BARCNT=0
SET BARTOT=0
+3 DO BASIC
+4 SET BARDR=DR
+5 ;
+6 SET ^XTMP("BAR-BEN",$JOB,0)=DT_U_DT_U_"AUTO POSTING OF BENEFICIARY BILLS LOG"
+7 SET BARBLDA=0
+8 FOR
SET BARBLDA=$ORDER(^BARBL(DUZ(2),"ABAL",BARACDA,BARBLDA))
IF '+BARBLDA
QUIT
Begin DoDot:1
+9 DO GET
+10 ;P.OTTIS TICKET # 66991
SET HAVETRIEN=0
+11 DO POST
+12 ;P.OTTIS TICKET # 66991
IF HAVETRIEN=0
QUIT
+13 IF BARTRIEN<1
QUIT
+14 DO LOG
End DoDot:1
+15 QUIT
+16 ; ********************************************************************
+17 ;
BASIC ;EP ASSEMBLE BASIC DATA FOR TRANSACTION
+1 ;
+2 ; Credit
SET DR="2////^ S X=BARBIL(15)"
+3 ; A/R Bill
SET DR=DR_";4////^S X=BARBLDA"
+4 ; A/R Patient
SET DR=DR_";5////^S X=BARBIL(101,""I"")"
+5 ; A/R Account
SET DR=DR_";6////^S X=BARBIL(3,""I"")"
+6 ; Parent Location
SET DR=DR_";8////^S X=DUZ(2)"
+7 ; Parent ASUFAC
SET DR=DR_";9////^S X=DUZ(2)"
+8 ; A/R Section
SET DR=DR_";10////^S X=BARBIL(10,""I"")"
+9 ; Visit Location
SET DR=DR_";11////^S X=BARBIL(108,""I"")"
+10 ; Date
SET DR=DR_";12////^S X=DT"
+11 ; Entry by
SET DR=DR_";13////^S X=DUZ"
+12 ; Transaction Type
SET DR=DR_";101////^S X=43"
+13 ; Adjust Cat Write Off
SET DR=DR_";102////3"
+14 ; Adjust type Indian Ben
SET DR=DR_";103////136"
+15 QUIT
+16 ; ********************************************************************
+17 ;
GET ;EP pull data for posting
+1 KILL BARBL
+2 DO ENP^XBDIQ1(90050.01,BARBLDA,".001;.01;3;10;13;15;18;101;102;108","BARBIL(","EI")
+3 IF $EXTRACT(IOST)="C"
WRITE "."
+4 QUIT
+5 ; ********************************************************************
+6 ;
POST ;EP
+1 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+2 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
QUIT
+3 ; SET TRANSACTION & POST FILES
+4 ; Create Transaction
SET BARTRIEN=$$NEW^BARTR
+5 ; Populate Transaction file
+6 IF BARTRIEN<1
DO MSG^BARTR(BARBLDA)
QUIT
+7 ;P.OTTIS TICKET # 66991
SET HAVETRIEN=1
+8 ; IEN to A/R TRANSACTION
SET DA=BARTRIEN
+9 SET DIE=90050.03
+10 SET DIDEL=90050
+11 SET DR=BARDR
+12 DO ^DIE
+13 KILL DIDEL,DIE,DA,DR
+14 ; Post from transaction file to related files
+15 DO TR^BARTDO(BARTRIEN)
+16 QUIT
+17 ; ********************************************************************
+18 ;
LOG ;EP
+1 ; log entry into ^XTMP
+2 IF BARSBY="P"
SET ^XTMP("BAR-BEN",$JOB,BARBIL(101),BARBIL(.01))=BARBIL(15)_U_BARBIL(102)
+3 IF BARSBY="B"
SET ^XTMP("BAR-BEN",$JOB,BARBIL(.01))=BARBIL(15)_U_BARBIL(102)_U_BARBIL(101)
+4 SET BARTOT=BARTOT+BARBIL(15)
+5 SET BARCNT=BARCNT+1
+6 QUIT
