BARTRANT ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92
;IHS/SD/POT - 1.8*28 - CR8397 HEAT155084 -NEW ROUTINE CLONED FROM BARTRNS
Q
; *********************************************************************
;
EN ; EP
K BARY,BAR ;Transaction Summary/Detail Report lop thru BARTR
S BAR("OPT")="ADJ" ; IHS/SD/PKD 1/3/11 1.8*20
D:'$D(BARUSR) INIT^BARUTL ; Set up basic A/R Variables
S BARP("RTN")="BARTRANT" ; Routine used to gather data ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
S BAR("PRIVACY")=1 ; Privacy act applies (used BARRHD)
S BAR("LOC")="VISIT" ; should always be VISIT
D ASK ; Ask questions
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) D XIT Q
D ADJTYPE^BARRSL3 ; Allow selection of Adjustment type(s) IHS/SD/PKD 1.8*20
D DATES ; Ask transaction date range
I +BARSTART<1 D XIT Q ; Dates answered wrong
; Ask rpt type (only if sort by allow cat/bill ent-return BARY("RTYP")
D RTYP ; Ask report type
I Y<1 D XIT Q ; Rtyp answered wrong or ^ P.OTT
; IHS/SD/PKD 1/25/11 1.8*20 Allow detail lines to all display $$
I BARY("RTYP")=2 D
. W !!,"Note: Some bills may contain more than one adjustment transaction on the report."
. S DIR("A")="Do you wish to print the billed and payment amount for each adjustment? "
. S DIR("B")="NO"
. S DIR(0)="Y"
. D ^DIR
. K DIR
. S BARDET=Y ; 0 if no, 1 if yes to print for each line
EN1 D SETHDR ; Build header array ;bar*1.8*20 added EN1 tag
S BARQ("RC")="COMPUTE^BARTRNS2" ; Build tmp global with data ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
S BARQ("RP")="PRINT^BARTRNS3" ; Print reports from tmp global bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
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
; *********************************************************************
ASK ; EP
S BARA("LOC")=0
S BARA("SORT")=0
D MSG^BARRSEL ; Message about BILL/VIS loc
D LOC^BARRSL1 ; Ask loc - return BARY("LOC")
Q:$D(DTOUT)!($D(DUOUT)) ; Q if time or "^" out
W:'$D(BARY("LOC")) "ALL"
F D SORT Q:BARA("SORT") ; Ask sort criteria-required
Q:'+$G(BARY("STCR")) ; No sort criteria specified - Q
I BARY("STCR")=1 D Q
. W !
. D ARACCT^BARRSL2 ; Ask A/R Account-return BARY(
I BARY("STCR")=2 D Q
. W !
. D ALL^BARRSL1 ; Ask allow cat-return BARY("ALL")
. Q:$D(DTOUT)!($D(DUOUT))
. W:'$D(BARY("ALL")) "ALL" ; If not select category, then ALL
I BARY("STCR")=3 D Q
. W !
. D ITYP^BARRSL1 ; Ask ins type-return BARY("ITYP")
. Q:$D(DTOUT)!($D(DUOUT))
. W:'$D(BARY("ITYP")) "ALL" ; If not select ins type,ALL
Q
; *********************************************************************
;
SORT ;
K DIR,BARY("STCR")
S DIR(0)="S^1:A/R ACCOUNT"
S DIR(0)=DIR(0)_";2:ALLOWANCE CATEGORY"
S DIR(0)=DIR(0)_";3:INSURER TYPE"
S DIR("A")="Select criteria for sorting"
S DIR("?")="This is a required response. Enter ^ to exit"
D ^DIR
K DIR
S:($D(DTOUT)!$D(DUOUT)) BARA("SORT")=1
Q:Y<1
S BARA("SORT")=1 ; The question was answered
S BARY("STCR")=+Y
S BARY("STCR","NM")=Y(0)
Q
;
RTYP ;
; Ask report type
S DIR(0)="S^1:Summarize by ALLOW CAT/INS TYPE"
S DIR(0)=DIR(0)_";2:Detail by PAYER w/in ALLOW CAT/INS TYPE"
S DIR("A")="Select REPORT TYPE"
S DIR("B")=1
S DIR("?",1)="Enter the selection that best describes the summary information desired"
S DIR("?")="Enter ^ to exit"
D ^DIR
K DIR
Q:Y<1
S BARY("RTYP")=+Y
S BARY("RTYP","NM")=Y(0)
Q
;
DATES ;
; Ask beginning and ending Transaction Dates.
W !!," ============ Entry of TRANSACTION DATE Range =============",!
K %DT ;bar*1.8*20
S BARSTART=$$DATE^BARDUTL(1)
K %DT ;bar*1.8*20
I BARSTART<1 Q
S BAREND=$$DATE^BARDUTL(2)
K %DT ;bar*1.8*20
I BAREND<1 W ! G DATES
I BAREND<BARSTART D G DATES
.W *7
.W !!,"The END date must not be before the START date.",!
S BARY("DT",1)=BARSTART
S BARY("DT",2)=BAREND
Q
; ********************************************************************
;
SETHDR ;
; Build header array
S BAR("OPT")="GAO"
S BARY("DT")="T"
S BAR("LVL")=0
S BAR("HD",0)="GAO Transaction Report"
I ",1,2,3,"[(","_BARY("STCR")_",") S BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")_" " ; - BAR*1.8*28 IHS/SD/POT CR8397 HEAT155084
I BARY("STCR")=2 D ALLOW^BARRHD,CHK^BARRHD
I BARY("STCR")=3 D ITYP^BARRHD,CHK^BARRHD
I $G(BARY("RTYP"))=1 D
.S BAR("LVL")=$G(BAR("LVL"))+1
.S BAR("HD",BAR("LVL"))=""
.S BAR("TXT")="Summary"
.S BAR("CONJ")=""
.D CHK^BARRHD
I $G(BARY("RTYP"))=2 D
.S BAR("LVL")=$G(BAR("LVL"))+1
.S BAR("HD",BAR("LVL"))=""
.S BAR("TXT")="Detail"
.S BAR("CONJ")=""
.D CHK^BARRHD
D DT^BARRHD
S BAR("LVL")=$G(BAR("LVL"))+1
S BAR("HD",BAR("LVL"))=""
S BAR("TXT")="ALL"
I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
I BAR("LOC")="BILLING" D
.S BAR("TXT")=BAR("TXT")_" Visit location(s) under "
.S BAR("TXT")=BAR("TXT")_$P(^DIC(4,DUZ(2),0),U)
.S BAR("TXT")=BAR("TXT")_" Billing Location"
E S BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
S BAR("CONJ")="at "
D CHK^BARRHD
Q
XIT ;
D ^BARVKL0
Q
;EOR - IHS/DIT/CPC 1.8*28
BARTRANT ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92
+2 ;IHS/SD/POT - 1.8*28 - CR8397 HEAT155084 -NEW ROUTINE CLONED FROM BARTRNS
+3 QUIT
+4 ; *********************************************************************
+5 ;
EN ; EP
+1 ;Transaction Summary/Detail Report lop thru BARTR
KILL BARY,BAR
+2 ; IHS/SD/PKD 1/3/11 1.8*20
SET BAR("OPT")="ADJ"
+3 ; Set up basic A/R Variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+4 ; Routine used to gather data ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
SET BARP("RTN")="BARTRANT"
+5 ; Privacy act applies (used BARRHD)
SET BAR("PRIVACY")=1
+6 ; should always be VISIT
SET BAR("LOC")="VISIT"
+7 ; Ask questions
DO ASK
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
DO XIT
QUIT
+9 ; Allow selection of Adjustment type(s) IHS/SD/PKD 1.8*20
DO ADJTYPE^BARRSL3
+10 ; Ask transaction date range
DO DATES
+11 ; Dates answered wrong
IF +BARSTART<1
DO XIT
QUIT
+12 ; Ask rpt type (only if sort by allow cat/bill ent-return BARY("RTYP")
+13 ; Ask report type
DO RTYP
+14 ; Rtyp answered wrong or ^ P.OTT
IF Y<1
DO XIT
QUIT
+15 ; IHS/SD/PKD 1/25/11 1.8*20 Allow detail lines to all display $$
+16 IF BARY("RTYP")=2
Begin DoDot:1
+17 WRITE !!,"Note: Some bills may contain more than one adjustment transaction on the report."
+18 SET DIR("A")="Do you wish to print the billed and payment amount for each adjustment? "
+19 SET DIR("B")="NO"
+20 SET DIR(0)="Y"
+21 DO ^DIR
+22 KILL DIR
+23 ; 0 if no, 1 if yes to print for each line
SET BARDET=Y
End DoDot:1
EN1 ; Build header array ;bar*1.8*20 added EN1 tag
DO SETHDR
+1 ; Build tmp global with data ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
SET BARQ("RC")="COMPUTE^BARTRNS2"
+2 ; Print reports from tmp global bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
SET BARQ("RP")="PRINT^BARTRNS3"
+3 ; Namespace for variables
SET BARQ("NS")="BAR"
+4 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+5 ; Double queuing
DO ^BARDBQUE
+6 ; Press return to continue
DO PAZ^BARRUTL
+7 QUIT
+8 ; *********************************************************************
ASK ; EP
+1 SET BARA("LOC")=0
+2 SET BARA("SORT")=0
+3 ; Message about BILL/VIS loc
DO MSG^BARRSEL
+4 ; Ask loc - return BARY("LOC")
DO LOC^BARRSL1
+5 ; Q if time or "^" out
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+6 IF '$DATA(BARY("LOC"))
WRITE "ALL"
+7 ; Ask sort criteria-required
FOR
DO SORT
IF BARA("SORT")
QUIT
+8 ; No sort criteria specified - Q
IF '+$GET(BARY("STCR"))
QUIT
+9 IF BARY("STCR")=1
Begin DoDot:1
+10 WRITE !
+11 ; Ask A/R Account-return BARY(
DO ARACCT^BARRSL2
End DoDot:1
QUIT
+12 IF BARY("STCR")=2
Begin DoDot:1
+13 WRITE !
+14 ; Ask allow cat-return BARY("ALL")
DO ALL^BARRSL1
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+16 ; If not select category, then ALL
IF '$DATA(BARY("ALL"))
WRITE "ALL"
End DoDot:1
QUIT
+17 IF BARY("STCR")=3
Begin DoDot:1
+18 WRITE !
+19 ; Ask ins type-return BARY("ITYP")
DO ITYP^BARRSL1
+20 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+21 ; If not select ins type,ALL
IF '$DATA(BARY("ITYP"))
WRITE "ALL"
End DoDot:1
QUIT
+22 QUIT
+23 ; *********************************************************************
+24 ;
SORT ;
+1 KILL DIR,BARY("STCR")
+2 SET DIR(0)="S^1:A/R ACCOUNT"
+3 SET DIR(0)=DIR(0)_";2:ALLOWANCE CATEGORY"
+4 SET DIR(0)=DIR(0)_";3:INSURER TYPE"
+5 SET DIR("A")="Select criteria for sorting"
+6 SET DIR("?")="This is a required response. Enter ^ to exit"
+7 DO ^DIR
+8 KILL DIR
+9 IF ($DATA(DTOUT)!$DATA(DUOUT))
SET BARA("SORT")=1
+10 IF Y<1
QUIT
+11 ; The question was answered
SET BARA("SORT")=1
+12 SET BARY("STCR")=+Y
+13 SET BARY("STCR","NM")=Y(0)
+14 QUIT
+15 ;
RTYP ;
+1 ; Ask report type
+2 SET DIR(0)="S^1:Summarize by ALLOW CAT/INS TYPE"
+3 SET DIR(0)=DIR(0)_";2:Detail by PAYER w/in ALLOW CAT/INS TYPE"
+4 SET DIR("A")="Select REPORT TYPE"
+5 SET DIR("B")=1
+6 SET DIR("?",1)="Enter the selection that best describes the summary information desired"
+7 SET DIR("?")="Enter ^ to exit"
+8 DO ^DIR
+9 KILL DIR
+10 IF Y<1
QUIT
+11 SET BARY("RTYP")=+Y
+12 SET BARY("RTYP","NM")=Y(0)
+13 QUIT
+14 ;
DATES ;
+1 ; Ask beginning and ending Transaction Dates.
+2 WRITE !!," ============ Entry of TRANSACTION DATE Range =============",!
+3 ;bar*1.8*20
KILL %DT
+4 SET BARSTART=$$DATE^BARDUTL(1)
+5 ;bar*1.8*20
KILL %DT
+6 IF BARSTART<1
QUIT
+7 SET BAREND=$$DATE^BARDUTL(2)
+8 ;bar*1.8*20
KILL %DT
+9 IF BAREND<1
WRITE !
GOTO DATES
+10 IF BAREND<BARSTART
Begin DoDot:1
+11 WRITE *7
+12 WRITE !!,"The END date must not be before the START date.",!
End DoDot:1
GOTO DATES
+13 SET BARY("DT",1)=BARSTART
+14 SET BARY("DT",2)=BAREND
+15 QUIT
+16 ; ********************************************************************
+17 ;
SETHDR ;
+1 ; Build header array
+2 SET BAR("OPT")="GAO"
+3 SET BARY("DT")="T"
+4 SET BAR("LVL")=0
+5 SET BAR("HD",0)="GAO Transaction Report"
+6 ; - BAR*1.8*28 IHS/SD/POT CR8397 HEAT155084
IF ",1,2,3,"[(","_BARY("STCR")_",")
SET BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")_" "
+7 IF BARY("STCR")=2
DO ALLOW^BARRHD
DO CHK^BARRHD
+8 IF BARY("STCR")=3
DO ITYP^BARRHD
DO CHK^BARRHD
+9 IF $GET(BARY("RTYP"))=1
Begin DoDot:1
+10 SET BAR("LVL")=$GET(BAR("LVL"))+1
+11 SET BAR("HD",BAR("LVL"))=""
+12 SET BAR("TXT")="Summary"
+13 SET BAR("CONJ")=""
+14 DO CHK^BARRHD
End DoDot:1
+15 IF $GET(BARY("RTYP"))=2
Begin DoDot:1
+16 SET BAR("LVL")=$GET(BAR("LVL"))+1
+17 SET BAR("HD",BAR("LVL"))=""
+18 SET BAR("TXT")="Detail"
+19 SET BAR("CONJ")=""
+20 DO CHK^BARRHD
End DoDot:1
+21 DO DT^BARRHD
+22 SET BAR("LVL")=$GET(BAR("LVL"))+1
+23 SET BAR("HD",BAR("LVL"))=""
+24 SET BAR("TXT")="ALL"
+25 IF $DATA(BARY("LOC"))
SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)
+26 IF BAR("LOC")="BILLING"
Begin DoDot:1
+27 SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "
+28 SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)
+29 SET BAR("TXT")=BAR("TXT")_" Billing Location"
End DoDot:1
+30 IF '$TEST
SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
+31 SET BAR("CONJ")="at "
+32 DO CHK^BARRHD
+33 QUIT
XIT ;
+1 DO ^BARVKL0
+2 QUIT
+3 ;EOR - IHS/DIT/CPC 1.8*28
