BARBAD1 ; IHS/SD/LSL - Posting and Adjustments ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**19,21**;OCT 26, 2005
;
EN() ; EP
; Batch Posting entry
K BARPAT,BARZ
D SELBILL
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT) 0
I $G(BARZ) Q BARZ
D ASKPAT
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT) 0
I $G(BARZ) Q BARZ
D GETBIL
I $G(BARZ) Q BARZ
Q 0
; *********************************************************************
;
TOP(BARV) ; EP
; Select Batch
W !!!
W "Select Batch: "_$P(BARCOL(0),U,1)
S Y=+BARCOL
D BATW^BARBAD
D BBAL^BARBAD(BARCOL)
W !!,"Select Item: "_BARITM
S Y=+BARITM
D DICW^BARBAD
D IBAL^BARBAD(BARITM)
I $G(BAREOB) D
.N DA
.W !!
.W "Select Visit Location: "
.S DA=BAREOB
.S DA(1)=+BARITM
.S DA(2)=+BARCOL
.W $$VAL^XBDIQ1(90051.1101601,.DA,.01)
.D EBAL^BARBAD(BAREOB)
Q:'BARV
W !!
W "Select Patient: "_$P(BARPAT(0),U,1)
Q
SELBILL ; EP
; select bill
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
;IM24235 BAR*1.8*1
I '$D(^BARBL(DUZ(2))) D Q
.W !!,$P(^DIC(4,DUZ(2),0),U)," DOES NOT HAVE ANY BILLS TO LIST!"
.K DIR
.S DIR(0)="E"
.D ^DIR
;END IM24235
K DIC
S DIC=90050.01
; IHS/SD/PKD 10/22/10 Selection Display-more info
S DIC("W")="D DISP^BARPUTL"
S DIC(0)="AEMQZ"
D ^DIC
Q:+Y<0
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ")
S BARPAT=$P(^BARBL(DUZ(2),+Y,1),"^",1)
S BARSTART=$P(^BARBL(DUZ(2),+Y,1),"^",2)
S BAREND=$P(^BARBL(DUZ(2),+Y,1),"^",3)
S:BAREND="" BAREND=BARSTART
S BARPAT(0)=$P($G(^DPT(+BARPAT,0)),"^",1)
S BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
Q
; *********************************************************************
;
GETBIL ;EP
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
;
W !
S DIC="^BARBL(DUZ(2),"
S DIC(0)="AEQZ"
S DIC("A")="Select Bill DOS: "
S D="E"
D IX^DIC
K DIC
Q:+Y<0
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ")
S BARPAT=$P(^BARBL(DUZ(2),+Y,1),"^",1)
S BARSTART=$P(^BARBL(DUZ(2),+Y,1),"^",2)
S BAREND=$P(^BARBL(DUZ(2),+Y,1),"^",3)
S BARPAT(0)=$P($G(^DPT(+BARPAT,0)),"^",2)
W " ",BARPAT(0)
S BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
Q
; *********************************************************************
;
ASKPAT ;EP - select patient
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
;
K DIC,BARZ
S DIC="^AUPNPAT("
S DIC(0)="IAEMQZ"
S DIC("S")="Select Patient: "
S DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"
D ^DIC
K DIC
Q:+Y<0
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ")
S BARPAT=+Y
S BARPAT(0)=Y(0)
S BARPAT(0)=$P($G(^DPT(+BARPAT,0)),"^",1)
D GETDOS
I '$G(BAROK) K BARPAT Q
S BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
Q
; *********************************************************************
;
GETDOS ; EP
; dates of service
K BARSTART,BAREND,BAROK
W !
S BARSTART=$$DATE^BARDUTL(1)
Q:BARSTART<0
S %DT("B")=$$MDT2^BARDUTL(BARSTART)
S BAREND=$$DATE^BARDUTL(2)
Q:BAREND<0
I BAREND<BARSTART D G GETDOS
.W *7
.D EOP^BARUTL(2)
.W !,"The END date must not be before the START date.",!
S BAROK=1
Q
BARBAD1 ; IHS/SD/LSL - Posting and Adjustments ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,21**;OCT 26, 2005
+2 ;
EN() ; EP
+1 ; Batch Posting entry
+2 KILL BARPAT,BARZ
+3 DO SELBILL
+4 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
QUIT 0
+5 IF $GET(BARZ)
QUIT BARZ
+6 DO ASKPAT
+7 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
QUIT 0
+8 IF $GET(BARZ)
QUIT BARZ
+9 DO GETBIL
+10 IF $GET(BARZ)
QUIT BARZ
+11 QUIT 0
+12 ; *********************************************************************
+13 ;
TOP(BARV) ; EP
+1 ; Select Batch
+2 WRITE !!!
+3 WRITE "Select Batch: "_$PIECE(BARCOL(0),U,1)
+4 SET Y=+BARCOL
+5 DO BATW^BARBAD
+6 DO BBAL^BARBAD(BARCOL)
+7 WRITE !!,"Select Item: "_BARITM
+8 SET Y=+BARITM
+9 DO DICW^BARBAD
+10 DO IBAL^BARBAD(BARITM)
+11 IF $GET(BAREOB)
Begin DoDot:1
+12 NEW DA
+13 WRITE !!
+14 WRITE "Select Visit Location: "
+15 SET DA=BAREOB
+16 SET DA(1)=+BARITM
+17 SET DA(2)=+BARCOL
+18 WRITE $$VAL^XBDIQ1(90051.1101601,.DA,.01)
+19 DO EBAL^BARBAD(BAREOB)
End DoDot:1
+20 IF 'BARV
QUIT
+21 WRITE !!
+22 WRITE "Select Patient: "_$PIECE(BARPAT(0),U,1)
+23 QUIT
SELBILL ; EP
+1 ; select bill
+2 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+3 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
QUIT
+4 ;IM24235 BAR*1.8*1
+5 IF '$DATA(^BARBL(DUZ(2)))
Begin DoDot:1
+6 WRITE !!,$PIECE(^DIC(4,DUZ(2),0),U)," DOES NOT HAVE ANY BILLS TO LIST!"
+7 KILL DIR
+8 SET DIR(0)="E"
+9 DO ^DIR
End DoDot:1
QUIT
+10 ;END IM24235
+11 KILL DIC
+12 SET DIC=90050.01
+13 ; IHS/SD/PKD 10/22/10 Selection Display-more info
+14 SET DIC("W")="D DISP^BARPUTL"
+15 SET DIC(0)="AEMQZ"
+16 DO ^DIC
+17 IF +Y<0
QUIT
+18 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")
QUIT
+19 SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)
+20 SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)
+21 SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)
+22 IF BAREND=""
SET BAREND=BARSTART
+23 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)
+24 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+25 QUIT
+26 ; *********************************************************************
+27 ;
GETBIL ;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 ;
+4 WRITE !
+5 SET DIC="^BARBL(DUZ(2),"
+6 SET DIC(0)="AEQZ"
+7 SET DIC("A")="Select Bill DOS: "
+8 SET D="E"
+9 DO IX^DIC
+10 KILL DIC
+11 IF +Y<0
QUIT
+12 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")
QUIT
+13 SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)
+14 SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)
+15 SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)
+16 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",2)
+17 WRITE " ",BARPAT(0)
+18 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+19 QUIT
+20 ; *********************************************************************
+21 ;
ASKPAT ;EP - select patient
+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 ;
+4 KILL DIC,BARZ
+5 SET DIC="^AUPNPAT("
+6 SET DIC(0)="IAEMQZ"
+7 SET DIC("S")="Select Patient: "
+8 SET DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"
+9 DO ^DIC
+10 KILL DIC
+11 IF +Y<0
QUIT
+12 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")
QUIT
+13 SET BARPAT=+Y
+14 SET BARPAT(0)=Y(0)
+15 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)
+16 DO GETDOS
+17 IF '$GET(BAROK)
KILL BARPAT
QUIT
+18 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+19 QUIT
+20 ; *********************************************************************
+21 ;
GETDOS ; EP
+1 ; dates of service
+2 KILL BARSTART,BAREND,BAROK
+3 WRITE !
+4 SET BARSTART=$$DATE^BARDUTL(1)
+5 IF BARSTART<0
QUIT
+6 SET %DT("B")=$$MDT2^BARDUTL(BARSTART)
+7 SET BAREND=$$DATE^BARDUTL(2)
+8 IF BAREND<0
QUIT
+9 IF BAREND<BARSTART
Begin DoDot:1
+10 WRITE *7
+11 DO EOP^BARUTL(2)
+12 WRITE !,"The END date must not be before the START date.",!
End DoDot:1
GOTO GETDOS
+13 SET BAROK=1
+14 QUIT
