BARPUTL ; IHS/SD/LSL - POSTING UTILITIES ; 07/08/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,19**;OCT 26, 2005
;
; IHS/SD/TMM 06/18/10 1.8*19 Add Prepayment functionality.
; *********************************************************************
Q
;
SELBILL ; EP
; select bill
;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
S DIC(0)="AEMQZ"
; IHS/SD/PKD 10/21/10
S DIC("W")="D DISP^BARPUTL"
D ^DIC
Q:+Y<0
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
; *********************************************************************
;
; IHS/SD/PKD 1.8*19 10/21/10
DISP ; New Tag Pt Lookup Display
; Naked reference - called from Fileman Display
N DOS,STAT,CURRAMT
Q:'$D(^(1)) ; No data,quit
S DOS=$$SHDT^BARDUTL($P(^(1),U,2))
S CURRAMT=$P(^(0),U,15) ;I CURRAMT=0 S CURRAMT="0.00"
;Extra spaces after tabs on purpose. keep fields apart.
S STAT=$S($D(^BARTBL(+$P(^(0),U,16),0))#2:$P(^(0),U,1),1:"")
W ?38," ",$J($FN(CURRAMT,"p",2),9)," ",?48,STAT,?55," ",DOS,?63," ",$P(^BARBL(DUZ(2),Y,1),U,16)
Q
GETBIL ;EP
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
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
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
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
;
ASKPATB(DICB) ;EP - select patient
; IHS/SD/TMM 1.8*19 7/6/10
; Copied from ASKPAT; allows user to pass default value for DIC("B"))
K DIC,BARZ
S DIC("B")=DICB
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
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
;
SELBILLB(DICB2) ; EP
; IHS/SD/TMM 1.8*19 7/11/10
; Copied from SELBILL: allows user to pass default value for DIC("B"))
; select bill
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
K DIC
S DIC("B")=DICB2
S DIC=90050.01
S DIC(0)="AEMQZ"
D ^DIC
Q:+Y<0
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
; *********************************************************************
;
GETBILB(DICB3) ;EP
; IHS/SD/TMM 1.8*19 7/11/10
; Copied from GETBIL: allows user to pass default value for DIC("B"))
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
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
; **************************
BARPUTL ; IHS/SD/LSL - POSTING UTILITIES ; 07/08/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,19**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/TMM 06/18/10 1.8*19 Add Prepayment functionality.
+4 ; *********************************************************************
+5 QUIT
+6 ;
SELBILL ; EP
+1 ; select bill
+2 ;IM24235 BAR*1.8*1
+3 IF '$DATA(^BARBL(DUZ(2)))
Begin DoDot:1
+4 WRITE !!,$PIECE(^DIC(4,DUZ(2),0),U)," DOES NOT HAVE ANY BILLS TO LIST!"
+5 KILL DIR
+6 SET DIR(0)="E"
+7 DO ^DIR
End DoDot:1
QUIT
+8 ;END IM24235
+9 KILL DIC
+10 SET DIC=90050.01
+11 SET DIC(0)="AEMQZ"
+12 ; IHS/SD/PKD 10/21/10
+13 SET DIC("W")="D DISP^BARPUTL"
+14 DO ^DIC
+15 IF +Y<0
QUIT
+16 SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)
+17 SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)
+18 SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)
+19 IF BAREND=""
SET BAREND=BARSTART
+20 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)
+21 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+22 QUIT
+23 ; *********************************************************************
+24 ;
+25 ; IHS/SD/PKD 1.8*19 10/21/10
DISP ; New Tag Pt Lookup Display
+1 ; Naked reference - called from Fileman Display
+2 NEW DOS,STAT,CURRAMT
+3 ; No data,quit
IF '$DATA(^(1))
QUIT
+4 SET DOS=$$SHDT^BARDUTL($PIECE(^(1),U,2))
+5 ;I CURRAMT=0 S CURRAMT="0.00"
SET CURRAMT=$PIECE(^(0),U,15)
+6 ;Extra spaces after tabs on purpose. keep fields apart.
+7 SET STAT=$SELECT($DATA(^BARTBL(+$PIECE(^(0),U,16),0))#2:$PIECE(^(0),U,1),1:"")
+8 WRITE ?38," ",$JUSTIFY($FNUMBER(CURRAMT,"p",2),9)," ",?48,STAT,?55," ",DOS,?63," ",$PIECE(^BARBL(DUZ(2),Y,1),U,16)
+9 QUIT
GETBIL ;EP
+1 WRITE !
+2 SET DIC="^BARBL(DUZ(2),"
+3 SET DIC(0)="AEQZ"
+4 SET DIC("A")="Select Bill DOS: "
+5 SET D="E"
+6 DO IX^DIC
+7 KILL DIC
+8 IF +Y<0
QUIT
+9 SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)
+10 SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)
+11 SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)
+12 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",2)
+13 WRITE " ",BARPAT(0)
+14 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+15 QUIT
+16 ; *********************************************************************
+17 ;
ASKPAT ;EP - select patient
+1 KILL DIC,BARZ
+2 SET DIC="^AUPNPAT("
+3 SET DIC(0)="IAEMQZ"
+4 SET DIC("S")="Select Patient: "
+5 SET DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"
+6 DO ^DIC
+7 KILL DIC
+8 IF +Y<0
QUIT
+9 SET BARPAT=+Y
+10 SET BARPAT(0)=Y(0)
+11 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)
+12 DO GETDOS
+13 IF '$GET(BAROK)
KILL BARPAT
QUIT
+14 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+15 QUIT
+16 ; *********************************************************************
+17 ;
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
+15 ;
ASKPATB(DICB) ;EP - select patient
+1 ; IHS/SD/TMM 1.8*19 7/6/10
+2 ; Copied from ASKPAT; allows user to pass default value for DIC("B"))
+3 KILL DIC,BARZ
+4 SET DIC("B")=DICB
+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 SET BARPAT=+Y
+13 SET BARPAT(0)=Y(0)
+14 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)
+15 DO GETDOS
+16 IF '$GET(BAROK)
KILL BARPAT
QUIT
+17 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+18 QUIT
+19 ;
SELBILLB(DICB2) ; EP
+1 ; IHS/SD/TMM 1.8*19 7/11/10
+2 ; Copied from SELBILL: allows user to pass default value for DIC("B"))
+3 ; select bill
+4 IF '$DATA(^BARBL(DUZ(2)))
Begin DoDot:1
+5 WRITE !!,$PIECE(^DIC(4,DUZ(2),0),U)," DOES NOT HAVE ANY BILLS TO LIST!"
+6 KILL DIR
+7 SET DIR(0)="E"
+8 DO ^DIR
End DoDot:1
QUIT
+9 KILL DIC
+10 SET DIC("B")=DICB2
+11 SET DIC=90050.01
+12 SET DIC(0)="AEMQZ"
+13 DO ^DIC
+14 IF +Y<0
QUIT
+15 SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)
+16 SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)
+17 SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)
+18 IF BAREND=""
SET BAREND=BARSTART
+19 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)
+20 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+21 QUIT
+22 ; *********************************************************************
+23 ;
GETBILB(DICB3) ;EP
+1 ; IHS/SD/TMM 1.8*19 7/11/10
+2 ; Copied from GETBIL: allows user to pass default value for DIC("B"))
+3 WRITE !
+4 SET DIC="^BARBL(DUZ(2),"
+5 SET DIC(0)="AEQZ"
+6 SET DIC("A")="Select Bill DOS: "
+7 SET D="E"
+8 DO IX^DIC
+9 KILL DIC
+10 IF +Y<0
QUIT
+11 SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)
+12 SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)
+13 SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)
+14 SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",2)
+15 WRITE " ",BARPAT(0)
+16 SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND
+17 QUIT
+18 ; **************************
