BARDINQ ; IHS/SD/LSL - A/R Debt Collection Bill Inquire ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
;
; IHS/SD/LSL - 04/28/2004 - V1.8
; Routine created.
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
Q
; ********************************************************************
;
EP ; EP
K BARY,BAR
D:'$D(BARUSR) INIT^BARUTL ; Set up basic A/R Variables
D SELBILL ; Select bill by #, pat, dos
Q:'$D(BARBIEN) ; Bill not selected
S BARPAT=$$GET1^DIQ(90050.01,BARBIEN,101)
D DATES^BARDLOG ; Ask date range
I +BARSTART<1 Q ;No dates entered
S BARQ("RC")="PROCESS^BARDINQ" ; Build tmp global with data
S BARQ("RP")="PRINT^BARDINQ" ; Print reports from tmp global
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
;D PAZ^BARRUTL ; Press return to continue
Q
; ********************************************************************
;
SELBILL ;
W !!
K DIC,DR,X,Y,DA
S DIC=90050.01
S DIC(0)="AEMQZ"
K DD,DO
D ^DIC
I $D(DUOUT)!($D(DTOUT)) Q
I +Y<0 D Q
. D PAT
. K BARTMP,BARPAT,BARDOS,BARBL,BARCNT
S BARBIEN=+Y
Q
; ********************************************************************
;
PAT ;
; If don't know bill, ask patient
N BARBL,BARCNT
K DIC,DA,DR,X,Y
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 BARDOS=0,BARCNT=0
F S BARDOS=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS)) Q:'+BARDOS D
. S BARBL=0
. F S BARBL=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS,BARBL)) Q:'+BARBL D
. . Q:'$D(^BARBL(DUZ(2),BARBL,0))
. . S BARCNT=BARCNT+1
. . S BARTMP(BARCNT)=$$GET1^DIQ(90050.01,BARBL,.01)_U_$$SDT^BARDUTL(BARDOS)_U_BARBL
;
W !
S BARCNT=0
F S BARCNT=$O(BARTMP(BARCNT)) Q:'+BARCNT D
. W !,$J(BARCNT,2),".",?5,$P(BARTMP(BARCNT),U),?40,$P(BARTMP(BARCNT),U,2)
;
S BARANS=0
W !
K DIR
S DIR(0)="NAO^1:"_BARCNT
S DIR("A")="Please enter the LINE # of the bill chosen for Inquiry: "
S DIR("?")="Enter a number between 1 and "_BARCNT
D ^DIR
Q:'+Y
S BARBIEN=$P(BARTMP(+Y),U,3)
Q
; ********************************************************************
; ********************************************************************
;
PROCESS ; EP
K ^TMP($J,"BAR-DLOG")
Q:'$D(^BARDEBT("C",BARBIEN)) ; Bill not in log.
S BARIEN=0
F S BARIEN=$O(^BARDEBT("C",BARBIEN,BARIEN)) Q:'+BARIEN D DATA
Q
; ********************************************************************
;
DATA ;
Q:'$D(^BARDEBT(BARIEN,0)) ; No data
Q:DUZ(2)'=$P($G(^BARDEBT(BARIEN,0)),U,8) ; Bill not this DUZ(2)
S BARDATE=$P($G(^BARDEBT(BARIEN,0)),U) ; date sent
Q:BARDATE<BARSTART
Q:BARDATE>BAREND
D DATA^BARDLOG ; Set temp global
Q
; ********************************************************************
; ********************************************************************
;
PRINT ; EP
K BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD
S BARHDR="DEBT COLLECTION BILL INQUIRY REPORT"
S BARPG=0
D NOW^%DTC
S Y=%
X ^DD("DD")
S BARUN=$P(Y,":",1,2)
S $P(BARDASH,"-",81)=""
D HEADP^BARDLOG
;
; No data
I '$D(^TMP($J,"BAR-DLOG")) D Q
. W !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)
. D PAZ^BARRUTL
;
W !?5,"Patient Name: ",$G(BARPAT)
S (BARTOT,BARCNT,BARSTOP)=0
S BARTOT2=0
S BARAC=""
F S BARAC=$O(^TMP($J,"BAR-DLOG",BARAC)) Q:BARAC="" D ACCTP^BARDLOG Q:BARSTOP
Q:BARSTOP
W !?42,"----------",?69,"----------"
W !?42,$J(BARTOT,10,2)," (",BARCNT,")",?69,$J(BARTOT2,10,2)
D PAZ^BARRUTL
Q
BARDINQ ; IHS/SD/LSL - A/R Debt Collection Bill Inquire ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 04/28/2004 - V1.8
+4 ; Routine created.
+5 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+6 QUIT
+7 ; ********************************************************************
+8 ;
EP ; EP
+1 KILL BARY,BAR
+2 ; Set up basic A/R Variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+3 ; Select bill by #, pat, dos
DO SELBILL
+4 ; Bill not selected
IF '$DATA(BARBIEN)
QUIT
+5 SET BARPAT=$$GET1^DIQ(90050.01,BARBIEN,101)
+6 ; Ask date range
DO DATES^BARDLOG
+7 ;No dates entered
IF +BARSTART<1
QUIT
+8 ; Build tmp global with data
SET BARQ("RC")="PROCESS^BARDINQ"
+9 ; Print reports from tmp global
SET BARQ("RP")="PRINT^BARDINQ"
+10 ; Namespace for variables
SET BARQ("NS")="BAR"
+11 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+12 ; Double queuing
DO ^BARDBQUE
+13 ;D PAZ^BARRUTL ; Press return to continue
+14 QUIT
+15 ; ********************************************************************
+16 ;
SELBILL ;
+1 WRITE !!
+2 KILL DIC,DR,X,Y,DA
+3 SET DIC=90050.01
+4 SET DIC(0)="AEMQZ"
+5 KILL DD,DO
+6 DO ^DIC
+7 IF $DATA">DATA(DUOUT)!($DATA">DATA(DTOUT))
QUIT
+8 IF +Y<0
Begin DoDot:1
+9 DO PAT
+10 KILL BARTMP,BARPAT,BARDOS,BARBL,BARCNT
End DoDot:1
QUIT
+11 SET BARBIEN=+Y
+12 QUIT
+13 ; ********************************************************************
+14 ;
PAT ;
+1 ; If don't know bill, ask patient
+2 NEW BARBL,BARCNT
+3 KILL DIC,DA,DR,X,Y
+4 SET DIC="^AUPNPAT("
+5 SET DIC(0)="IAEMQZ"
+6 SET DIC("S")="Select Patient: "
+7 SET DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"
+8 DO ^DIC
+9 KILL DIC
+10 IF +Y<0
QUIT
+11 SET BARPAT=+Y
+12 ;
+13 SET BARDOS=0
SET BARCNT=0
+14 FOR
SET BARDOS=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS))
IF '+BARDOS
QUIT
Begin DoDot:1
+15 SET BARBL=0
+16 FOR
SET BARBL=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS,BARBL))
IF '+BARBL
QUIT
Begin DoDot:2
+17 IF '$DATA(^BARBL(DUZ(2),BARBL,0))
QUIT
+18 SET BARCNT=BARCNT+1
+19 SET BARTMP(BARCNT)=$$GET1^DIQ(90050.01,BARBL,.01)_U_$$SDT^BARDUTL(BARDOS)_U_BARBL
End DoDot:2
End DoDot:1
+20 ;
+21 WRITE !
+22 SET BARCNT=0
+23 FOR
SET BARCNT=$ORDER(BARTMP(BARCNT))
IF '+BARCNT
QUIT
Begin DoDot:1
+24 WRITE !,$JUSTIFY(BARCNT,2),".",?5,$PIECE(BARTMP(BARCNT),U),?40,$PIECE(BARTMP(BARCNT),U,2)
End DoDot:1
+25 ;
+26 SET BARANS=0
+27 WRITE !
+28 KILL DIR
+29 SET DIR(0)="NAO^1:"_BARCNT
+30 SET DIR("A")="Please enter the LINE # of the bill chosen for Inquiry: "
+31 SET DIR("?")="Enter a number between 1 and "_BARCNT
+32 DO ^DIR
+33 IF '+Y
QUIT
+34 SET BARBIEN=$PIECE(BARTMP(+Y),U,3)
+35 QUIT
+36 ; ********************************************************************
+37 ; ********************************************************************
+38 ;
PROCESS ; EP
+1 KILL ^TMP($JOB,"BAR-DLOG")
+2 ; Bill not in log.
IF '$DATA(^BARDEBT("C",BARBIEN))
QUIT
+3 SET BARIEN=0
+4 FOR
SET BARIEN=$ORDER(^BARDEBT("C",BARBIEN,BARIEN))
IF '+BARIEN
QUIT
DO DATA
+5 QUIT
+6 ; ********************************************************************
+7 ;
DATA ;
+1 ; No data
IF '$DATA(^BARDEBT(BARIEN,0))
QUIT
+2 ; Bill not this DUZ(2)
IF DUZ(2)'=$PIECE($GET(^BARDEBT(BARIEN,0)),U,8)
QUIT
+3 ; date sent
SET BARDATE=$PIECE($GET(^BARDEBT(BARIEN,0)),U)
+4 IF BARDATE<BARSTART
QUIT
+5 IF BARDATE>BAREND
QUIT
+6 ; Set temp global
DO DATA^BARDLOG
+7 QUIT
+8 ; ********************************************************************
+9 ; ********************************************************************
+10 ;
PRINT ; EP
+1 KILL BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD
+2 SET BARHDR="DEBT COLLECTION BILL INQUIRY REPORT"
+3 SET BARPG=0
+4 DO NOW^%DTC
+5 SET Y=%
+6 XECUTE ^DD("DD")
+7 SET BARUN=$PIECE(Y,":",1,2)
+8 SET $PIECE(BARDASH,"-",81)=""
+9 DO HEADP^BARDLOG
+10 ;
+11 ; No data
+12 IF '$DATA(^TMP($JOB,"BAR-DLOG"))
Begin DoDot:1
+13 WRITE !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)
+14 DO PAZ^BARRUTL
End DoDot:1
QUIT
+15 ;
+16 WRITE !?5,"Patient Name: ",$GET(BARPAT)
+17 SET (BARTOT,BARCNT,BARSTOP)=0
+18 SET BARTOT2=0
+19 SET BARAC=""
+20 FOR
SET BARAC=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC))
IF BARAC=""
QUIT
DO ACCTP^BARDLOG
IF BARSTOP
QUIT
+21 IF BARSTOP
QUIT
+22 WRITE !?42,"----------",?69,"----------"
+23 WRITE !?42,$JUSTIFY(BARTOT,10,2)," (",BARCNT,")",?69,$JUSTIFY(BARTOT2,10,2)
+24 DO PAZ^BARRUTL
+25 QUIT
