- BARTRANS ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,19,20,23,28**;OCT 26, 2005;Build 92
- ;NEW ROUTINE BAR*1.8*10 H2470
- ;IHS/SD/POT 1.8*23 01-OCT-2012 HEAT # 86006 P.OTT FIXING RTYP answered wrong
- ;IHS/SD/SDR - 1.8*28 - Updated p23 documentation
- ;IHS/SD/SDR,POT - 1.8*28 - CR8397 HEAT155084 - Made changes to do report by 3p approval date, not transaction date
- Q
- ; *********************************************************************
- ;
- EN ; EP
- K BARY,BAR
- 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")="BARTRANS" ; Routine used to gather data
- 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 ^ ;bar*1.8*23 IHS/SD/POT HEAT86006
- ; 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^BARTRNS1" ; Build tmp global with data
- S BARQ("RP")="PRINT^BARTRNS1" ; 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
- ; *********************************************************************
- 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 =============",! ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- W !!," ============ Entry of 3P APPROVAL DATE Range =============",! ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- 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" ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- S BARY("DT")="A" ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- 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")
- 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
- BARTRANS ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,19,20,23,28**;OCT 26, 2005;Build 92
- +2 ;NEW ROUTINE BAR*1.8*10 H2470
- +3 ;IHS/SD/POT 1.8*23 01-OCT-2012 HEAT # 86006 P.OTT FIXING RTYP answered wrong
- +4 ;IHS/SD/SDR - 1.8*28 - Updated p23 documentation
- +5 ;IHS/SD/SDR,POT - 1.8*28 - CR8397 HEAT155084 - Made changes to do report by 3p approval date, not transaction date
- +6 QUIT
- +7 ; *********************************************************************
- +8 ;
- EN ; EP
- +1 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
- SET BARP("RTN")="BARTRANS"
- +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 ^ ;bar*1.8*23 IHS/SD/POT HEAT86006
- 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
- SET BARQ("RC")="COMPUTE^BARTRNS1"
- +2 ; Print reports from tmp global
- SET BARQ("RP")="PRINT^BARTRNS1"
- +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 ;W !!," ============ Entry of TRANSACTION DATE Range =============",! ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- +3 ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- WRITE !!," ============ Entry of 3P APPROVAL DATE Range =============",!
- +4 ;bar*1.8*20
- KILL %DT
- +5 SET BARSTART=$$DATE^BARDUTL(1)
- +6 ;bar*1.8*20
- KILL %DT
- +7 IF BARSTART<1
- QUIT
- +8 SET BAREND=$$DATE^BARDUTL(2)
- +9 ;bar*1.8*20
- KILL %DT
- +10 IF BAREND<1
- WRITE !
- GOTO DATES
- +11 IF BAREND<BARSTART
- Begin DoDot:1
- +12 WRITE *7
- +13 WRITE !!,"The END date must not be before the START date.",!
- End DoDot:1
- GOTO DATES
- +14 SET BARY("DT",1)=BARSTART
- +15 SET BARY("DT",2)=BAREND
- +16 QUIT
- +17 ; ********************************************************************
- +18 ;
- SETHDR ;
- +1 ; Build header array
- +2 SET BAR("OPT")="GAO"
- +3 ;S BARY("DT")="T" ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- +4 ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
- SET BARY("DT")="A"
- +5 SET BAR("LVL")=0
- +6 SET BAR("HD",0)="GAO Transaction Report"
- +7 IF ",1,2,3,"[(","_BARY("STCR")_",")
- SET BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")
- +8 IF BARY("STCR")=2
- DO ALLOW^BARRHD
- DO CHK^BARRHD
- +9 IF BARY("STCR")=3
- DO ITYP^BARRHD
- DO CHK^BARRHD
- +10 IF $GET(BARY("RTYP"))=1
- Begin DoDot:1
- +11 SET BAR("LVL")=$GET(BAR("LVL"))+1
- +12 SET BAR("HD",BAR("LVL"))=""
- +13 SET BAR("TXT")="Summary"
- +14 SET BAR("CONJ")=""
- +15 DO CHK^BARRHD
- End DoDot:1
- +16 IF $GET(BARY("RTYP"))=2
- Begin DoDot:1
- +17 SET BAR("LVL")=$GET(BAR("LVL"))+1
- +18 SET BAR("HD",BAR("LVL"))=""
- +19 SET BAR("TXT")="Detail"
- +20 SET BAR("CONJ")=""
- +21 DO CHK^BARRHD
- End DoDot:1
- +22 DO DT^BARRHD
- +23 SET BAR("LVL")=$GET(BAR("LVL"))+1
- +24 SET BAR("HD",BAR("LVL"))=""
- +25 SET BAR("TXT")="ALL"
- +26 IF $DATA(BARY("LOC"))
- SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)
- +27 IF BAR("LOC")="BILLING"
- Begin DoDot:1
- +28 SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "
- +29 SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)
- +30 SET BAR("TXT")=BAR("TXT")_" Billing Location"
- End DoDot:1
- +31 IF '$TEST
- SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
- +32 SET BAR("CONJ")="at "
- +33 DO CHK^BARRHD
- +34 QUIT
- XIT ;
- +1 DO ^BARVKL0
- +2 QUIT
- +3 ;EOR - IHS/DIT/CPC 1.8*28