Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARTRANS

BARTRANS.m

Go to the documentation of this file.
  1. 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
  1. ;NEW ROUTINE BAR*1.8*10 H2470
  1. ;IHS/SD/POT 1.8*23 01-OCT-2012 HEAT # 86006 P.OTT FIXING RTYP answered wrong
  1. ;IHS/SD/SDR - 1.8*28 - Updated p23 documentation
  1. ;IHS/SD/SDR,POT - 1.8*28 - CR8397 HEAT155084 - Made changes to do report by 3p approval date, not transaction date
  1. Q
  1. ; *********************************************************************
  1. ;
  1. EN ; EP
  1. K BARY,BAR
  1. S BAR("OPT")="ADJ" ; IHS/SD/PKD 1/3/11 1.8*20
  1. D:'$D(BARUSR) INIT^BARUTL ; Set up basic A/R Variables
  1. S BARP("RTN")="BARTRANS" ; Routine used to gather data
  1. S BAR("PRIVACY")=1 ; Privacy act applies (used BARRHD)
  1. S BAR("LOC")="VISIT" ; should always be VISIT
  1. D ASK ; Ask questions
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) D XIT Q
  1. D ADJTYPE^BARRSL3 ; Allow selection of Adjustment type(s) IHS/SD/PKD 1.8*20
  1. D DATES ; Ask transaction date range
  1. I +BARSTART<1 D XIT Q ; Dates answered wrong
  1. ; Ask rpt type (only if sort by allow cat/bill ent-return BARY("RTYP")
  1. D RTYP ; Ask report type
  1. I Y<1 D XIT Q ;Rtyp answered wrong or ^ ;bar*1.8*23 IHS/SD/POT HEAT86006
  1. ; IHS/SD/PKD 1/25/11 1.8*20 Allow detail lines to all display $$
  1. I BARY("RTYP")=2 D
  1. . W !!,"Note: Some bills may contain more than one adjustment transaction on the report."
  1. . S DIR("A")="Do you wish to print the billed and payment amount for each adjustment? "
  1. . S DIR("B")="NO"
  1. . S DIR(0)="Y"
  1. . D ^DIR
  1. . K DIR
  1. . S BARDET=Y ; 0 if no, 1 if yes to print for each line
  1. EN1 D SETHDR ; Build header array ;bar*1.8*20 added EN1 tag
  1. S BARQ("RC")="COMPUTE^BARTRNS1" ; Build tmp global with data
  1. S BARQ("RP")="PRINT^BARTRNS1" ; Print reports from tmp global
  1. S BARQ("NS")="BAR" ; Namespace for variables
  1. S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
  1. D ^BARDBQUE ; Double queuing
  1. D PAZ^BARRUTL ; Press return to continue
  1. Q
  1. ; *********************************************************************
  1. ASK ; EP
  1. S BARA("LOC")=0
  1. S BARA("SORT")=0
  1. D MSG^BARRSEL ; Message about BILL/VIS loc
  1. D LOC^BARRSL1 ; Ask loc - return BARY("LOC")
  1. Q:$D(DTOUT)!($D(DUOUT)) ; Q if time or "^" out
  1. W:'$D(BARY("LOC")) "ALL"
  1. F D SORT Q:BARA("SORT") ; Ask sort criteria-required
  1. Q:'+$G(BARY("STCR")) ; No sort criteria specified - Q
  1. I BARY("STCR")=1 D Q
  1. . W !
  1. . D ARACCT^BARRSL2 ; Ask A/R Account-return BARY(
  1. I BARY("STCR")=2 D Q
  1. . W !
  1. . D ALL^BARRSL1 ; Ask allow cat-return BARY("ALL")
  1. . Q:$D(DTOUT)!($D(DUOUT))
  1. . W:'$D(BARY("ALL")) "ALL" ; If not select category, then ALL
  1. I BARY("STCR")=3 D Q
  1. . W !
  1. . D ITYP^BARRSL1 ; Ask ins type-return BARY("ITYP")
  1. . Q:$D(DTOUT)!($D(DUOUT))
  1. . W:'$D(BARY("ITYP")) "ALL" ; If not select ins type,ALL
  1. Q
  1. ; *********************************************************************
  1. ;
  1. SORT ;
  1. K DIR,BARY("STCR")
  1. S DIR(0)="S^1:A/R ACCOUNT"
  1. S DIR(0)=DIR(0)_";2:ALLOWANCE CATEGORY"
  1. S DIR(0)=DIR(0)_";3:INSURER TYPE"
  1. S DIR("A")="Select criteria for sorting"
  1. S DIR("?")="This is a required response. Enter ^ to exit"
  1. D ^DIR
  1. K DIR
  1. S:($D(DTOUT)!$D(DUOUT)) BARA("SORT")=1
  1. Q:Y<1
  1. S BARA("SORT")=1 ; The question was answered
  1. S BARY("STCR")=+Y
  1. S BARY("STCR","NM")=Y(0)
  1. Q
  1. ;
  1. RTYP ;
  1. ; Ask report type
  1. S DIR(0)="S^1:Summarize by ALLOW CAT/INS TYPE"
  1. S DIR(0)=DIR(0)_";2:Detail by PAYER w/in ALLOW CAT/INS TYPE"
  1. S DIR("A")="Select REPORT TYPE"
  1. S DIR("B")=1
  1. S DIR("?",1)="Enter the selection that best describes the summary information desired"
  1. S DIR("?")="Enter ^ to exit"
  1. D ^DIR
  1. K DIR
  1. Q:Y<1
  1. S BARY("RTYP")=+Y
  1. S BARY("RTYP","NM")=Y(0)
  1. Q
  1. ;
  1. DATES ;
  1. ; Ask beginning and ending Transaction Dates.
  1. ;W !!," ============ Entry of TRANSACTION DATE Range =============",! ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1. W !!," ============ Entry of 3P APPROVAL DATE Range =============",! ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1. K %DT ;bar*1.8*20
  1. S BARSTART=$$DATE^BARDUTL(1)
  1. K %DT ;bar*1.8*20
  1. I BARSTART<1 Q
  1. S BAREND=$$DATE^BARDUTL(2)
  1. K %DT ;bar*1.8*20
  1. I BAREND<1 W ! G DATES
  1. I BAREND<BARSTART D G DATES
  1. .W *7
  1. .W !!,"The END date must not be before the START date.",!
  1. S BARY("DT",1)=BARSTART
  1. S BARY("DT",2)=BAREND
  1. Q
  1. ; ********************************************************************
  1. ;
  1. SETHDR ;
  1. ; Build header array
  1. S BAR("OPT")="GAO"
  1. ;S BARY("DT")="T" ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1. S BARY("DT")="A" ;bar*1.8*28 IHS/SD/POT CR8397 HEAT155084
  1. S BAR("LVL")=0
  1. S BAR("HD",0)="GAO Transaction Report"
  1. I ",1,2,3,"[(","_BARY("STCR")_",") S BAR("HD",0)=BAR("HD",0)_" by "_BARY("STCR","NM")
  1. I BARY("STCR")=2 D ALLOW^BARRHD,CHK^BARRHD
  1. I BARY("STCR")=3 D ITYP^BARRHD,CHK^BARRHD
  1. I $G(BARY("RTYP"))=1 D
  1. .S BAR("LVL")=$G(BAR("LVL"))+1
  1. .S BAR("HD",BAR("LVL"))=""
  1. .S BAR("TXT")="Summary"
  1. .S BAR("CONJ")=""
  1. .D CHK^BARRHD
  1. I $G(BARY("RTYP"))=2 D
  1. .S BAR("LVL")=$G(BAR("LVL"))+1
  1. .S BAR("HD",BAR("LVL"))=""
  1. .S BAR("TXT")="Detail"
  1. .S BAR("CONJ")=""
  1. .D CHK^BARRHD
  1. D DT^BARRHD
  1. S BAR("LVL")=$G(BAR("LVL"))+1
  1. S BAR("HD",BAR("LVL"))=""
  1. S BAR("TXT")="ALL"
  1. I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
  1. I BAR("LOC")="BILLING" D
  1. .S BAR("TXT")=BAR("TXT")_" Visit location(s) under "
  1. .S BAR("TXT")=BAR("TXT")_$P(^DIC(4,DUZ(2),0),U)
  1. .S BAR("TXT")=BAR("TXT")_" Billing Location"
  1. E S BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
  1. S BAR("CONJ")="at "
  1. D CHK^BARRHD
  1. Q
  1. XIT ;
  1. D ^BARVKL0
  1. Q
  1. ;EOR - IHS/DIT/CPC 1.8*28