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

BARRHD.m

Go to the documentation of this file.
  1. BARRHD ; IHS/SD/LSL - Report Header Generator ; 07/28/2010
  1. ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,6,10,19,23,24*;OCT 26, 2005;Build 69
  1. ;
  1. ; TMM 07/25/2010 V1.8*19
  1. ; - Modify A/R Statitical Report to allow user to
  1. ; filter specific (Employer) Group Plans when
  1. ; BILLING ENTITY/6)SELECT A SPECIFIC A/R ACCOUNT
  1. ; - Allow user to select report to print in printer OR delimited file format
  1. ;
  1. ; IHS/SD/POTT 07/13 ADDED SUPPORT FOR ICD-10 - BAR*1.8*23
  1. ; IHS/SD/POTT HEAT148395 01/10/14 FIXING WRONG BILLING SOURCE - BAR*1.8*24
  1. ; IHS/SD/POTT HEAT150941 02/09/14 Allow ALL DX9/10 - - BAR*1.8*24
  1. ; *********************************************************************
  1. ;
  1. HD ;EP for setting Report Header
  1. I $D(BARY("ALL")) D ALLOW
  1. E D BIL ; Billing entity parameters and A/R Account
  1. D CHK ; Build header level array
  1. D LOC ; Location parameters
  1. D:$D(BARY("DT")) DT ; Date parameters
  1. D:$D(BARY("PRV")) PRV ; Provider parameter
  1. I BAR("OPT")="IPDR" D
  1. . D DSCHG ; Discharge service
  1. . D DX ; Diagnosis Range
  1. Q
  1. ; *********************************************************************
  1. ;
  1. BIL ; EP
  1. ; Billing entity parameters
  1. S BAR("LVL")=0
  1. S BAR("CONJ")="for "
  1. I $G(BAR("OPT"))="STA",$D(BARY("ACCT")) D Q ;M819*ADD*TMM*20100816
  1. . S BARTMPG=$S($G(BARY("GRP PLAN"))>0:"GROUPS: ",1:"GROUP: ")
  1. . S BAR("TXT")=BARY("ACCT","NM")_" "_BARTMPG
  1. . I '$D(BARY("GRP PLAN")) S BAR("TXT")=BAR("TXT")_"ALL GROUPS"
  1. . I $D(BARY("GRP PLAN")) D
  1. .. S BARGPCNT=0
  1. .. S BARGRP="" F S BARGRP=$O(BARY("GRP PLAN",BARGRP)) Q:BARGRP="" D
  1. ... S BARGPCNT=BARGPCNT+1
  1. ... I BARGPCNT'=1 S BAR("TXT")=BAR("TXT")_","
  1. ... S BAR("TXT")=BAR("TXT")_$G(BARY("GRP PLAN",BARGRP))
  1. S BAR("TXT")="ALL"
  1. I $D(BARY("PAT")) S BAR("TXT")=$P(^DPT(BARY("PAT"),0),U) Q
  1. I $D(BARY("TYP")) D
  1. . ; OLD CODE - BAR*1.8*24
  1. . ;I BARY("TYP")=(U_"R"_U_"MD"_U_"MH"_U) S BAR("TXT")="MEDICARE" Q
  1. . ;I BARY("TYP")=(U_"D"_U) S BAR("TXT")="MEDICAID" Q
  1. . ;I BARY("TYP")=(U_"W"_U) S BAR("TXT")="WORKMEN'S COMP" Q
  1. . ;I BARY("TYP")[(U_"W"_U)&(BARY("TYP")[(U_"P"_U)) S BAR("TXT")="PRIVATE+WORKMEN'S COMP" Q
  1. . ;I BARY("TYP")[(U_"P"_U)&(BARY("TYP")'[(U_"W"_U)) S BAR("TXT")="PRIVATE INSURANCE" Q
  1. . ;-NEW CODE - BAR*1.8*24
  1. . I BARY("TYP")[(U_"R"_U) S BAR("TXT")="MEDICARE" Q
  1. . I BARY("TYP")[(U_"D"_U) S BAR("TXT")="MEDICAID" Q
  1. . I BARY("TYP")=(U_"W"_U) S BAR("TXT")="WORKMEN'S COMP" Q
  1. . I BARY("TYP")[(U_"W"_U)&(BARY("TYP")[(U_"P"_U)) S BAR("TXT")="PRIVATE+WORKMEN'S COMP" Q
  1. . I BARY("TYP")[(U_"P"_U)&(BARY("TYP")'[(U_"W"_U)) S BAR("TXT")="PRIVATE INSURANCE" Q
  1. . I BARY("TYP")=(U_"N"_U) S BAR("TXT")="NON-BENEFICIARY PATIENTS" Q
  1. . I BARY("TYP")=(U_"I"_U) S BAR("TXT")="BENEFICIARY PATIENTS" Q
  1. . I BARY("TYP")=(U_"K"_U) S BAR("TXT")="CHIP" Q
  1. . I BARY("TYP")=(U_"V"_U) S BAR("TXT")="VETERANS" Q
  1. . I BARY("TYP")[(U_"G"_U) S BAR("TXT")="OTHER" Q
  1. . S BAR("TXT")="UNSPECIFIED"
  1. S BAR("TXT")=BAR("TXT")_" BILLING SOURCE(S)"
  1. Q
  1. ; *********************************************************************
  1. ;
  1. LOC ; EP
  1. ; Location
  1. I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
  1. E S BAR("TXT")="ALL"
  1. I BAR("LOC")="BILLING" D
  1. . S BAR("TXT")=BAR("TXT")_" Visit location 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 regardless of Billing Location"
  1. S BAR("CONJ")="at "
  1. D CHK
  1. Q
  1. ; *********************************************************************
  1. ;
  1. DT ; EP
  1. ; Date
  1. S BAR("CONJ")="with "
  1. S BAR("TXT")=$S(BARY("DT")="A":"APPROVAL DATES",BARY("DT")="V":"VISIT DATES",BARY("DT")="X":"EXPORT DATES",1:"TRANSACTION DATES")
  1. I BAR("OPT")="IPDR",BARY("DT")="V" S BAR("TXT")="ADMISSION DATES"
  1. I BARY("DT")="B" S BAR("TXT")="COLLECTION BATCH DATES" ;MRS:BAR*1.8*10 IM30590
  1. D CHK
  1. S BAR("CONJ")="from "
  1. S BAR("TXT")=$$SDT^BARDUTL(BARY("DT",1))
  1. D CHK
  1. S BAR("CONJ")="to "
  1. S BAR("TXT")=$$SDT^BARDUTL(BARY("DT",2))
  1. D CHK
  1. Q
  1. ; *********************************************************************
  1. ;
  1. PRV ;
  1. ; Providers
  1. S BAR("CONJ")="provided by "
  1. S BAR("TXT")=$P(^VA(200,BARY("PRV"),0),U)
  1. D CHK
  1. Q
  1. ; *********************************************************************
  1. ;
  1. XIT ;
  1. K BAR("CONJ"),BAR("TXT"),BAR("LVL")
  1. Q
  1. ; *********************************************************************
  1. ;
  1. CHK ; EP
  1. I ($L(BAR("HD",BAR("LVL")))+1+$L(BAR("CONJ"))+$L(BAR("TXT")))<($S($D(BAR(132)):104,1:52)+$S(BAR("LVL")>0:28,1:0)) D
  1. . S BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_" "_BAR("CONJ")_BAR("TXT")
  1. . Q
  1. E S BAR("LVL")=BAR("LVL")+1,BAR("HD",BAR("LVL"))=BAR("CONJ")_BAR("TXT")_$$TEXTCK^BARDRST()
  1. Q
  1. ; *********************************************************************
  1. ;
  1. WHD ;EP for writing Report Header
  1. W $$EN^BARVDF("IOF"),! ;not a delimited file
  1. I $D(BAR("PRIVACY")),$G(BARTEXT)'=1 W ?($S($D(BAR(132)):34,$D(BAR(180)):68,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",! ;BAR*1.8*6 ITEM 2
  1. I $D(BAR("PRIVACY")),$G(BARTEXT)=1 W "^","WARNING: Confidential Patient Information, Privacy Act Applies",! ;BAR*1.8*6 ITEM 2
  1. K BAR("LINE")
  1. S $P(BAR("LINE"),"=",$S($D(BAR(133)):132,$D(BAR(180)):181,1:81))="" ;BAR*1.8*6 ITEM 2 ;M819*DEL*TMM*20100731
  1. W BAR("LINE"),!
  1. I $G(BARTEXT)'=1 W BAR("HD",0),?$S($D(BAR(132)):102,$D(BAR(180)):150,1:51) ;BAR*1.8*6 ITEM 2 ;M819*DEL*TMM*20100731
  1. I $G(BARTEXT)=1 W BAR("HD",0),"^^^^" ;BAR*1.8*6 ITEM 2 ;M819*ADD*TMM*20100731 adv to column 6
  1. D NOW^%DTC
  1. S Y=%
  1. X ^DD("DD")
  1. W $P(Y,":",1,2)," Page ",BAR("PG")
  1. I $G(BARTEXT)=1 W "^" ;M819*ADD*TMM*20100731
  1. S BAR("TMPLVL")=0
  1. F S BAR("TMPLVL")=$O(BAR("HD",BAR("TMPLVL"))) Q:'BAR("TMPLVL")&(BAR("TMPLVL")'=0) W:$G(BAR("HD",BAR("TMPLVL")))]"" !,BAR("HD",BAR("TMPLVL"))
  1. W !,BAR("LINE")
  1. K BAR("LINE")
  1. Q
  1. ; *********************************************************************
  1. ;
  1. ALLOW ; EP
  1. ; Allowance Category Parameters
  1. S BAR("LVL")=0
  1. S BAR("CONJ")="for "
  1. S BAR("TXT")="ALL"
  1. I $D(BARY("ALL")) D
  1. . I BARY("ALL")=1!(BARY("ALL")="R") S BAR("TXT")="MEDICARE" Q
  1. . I BARY("ALL")=2!(BARY("ALL")="D") S BAR("TXT")="MEDICAID" Q
  1. . I BARY("ALL")=3!(BARY("ALL")="P") S BAR("TXT")="PRIVATE INSURANCE" Q
  1. . I BARY("ALL")=4!(BARY("ALL")="V") S BAR("TXT")="VETERANS" Q
  1. . I BARY("ALL")=5!(BARY("ALL")="O") S BAR("TXT")="OTHER" Q ;BAR*1.8*6 DD 4.1.1 IM21585
  1. . S BAR("TXT")="OTHER"
  1. S BAR("TXT")=BAR("TXT")_" ALLOWANCE CATEGORY(S)"
  1. S BAR("TXT")=BAR("TXT")_$$TEXTCK^BARDRST() ;formatting if delimited file M819*ADD*TMM*20100731
  1. Q
  1. ;
  1. ; ********************************************************************
  1. ;
  1. DSCHG ;
  1. ; Discharge Service
  1. S BAR("TXT")="ALL"
  1. S:$D(BARY("DSVC")) BAR("TXT")=BARY("DSVC","NM")
  1. S BAR("TXT")=BAR("TXT")_" Discharge Services"
  1. S BAR("CONJ")="for "
  1. D CHK
  1. S BAR("TXT")=""
  1. S BAR("CONJ")=""
  1. Q
  1. ; ********************************************************************
  1. ;
  1. DX ;
  1. ; Diagnosis Range modified P.OTT
  1. NEW BARICDVR,BARTMP1
  1. S BARTMP1=0
  1. I $G(BARY("DXTYPE"))="P" S BARTMP1=1
  1. ;I $G(BARY("DXTYPE"))="O" S BARTMP1=2
  1. ;I $G(BARY("DXTYPE"))="A" S BARTMP1=3
  1. I $G(BARY("DX9"))="ALL" I $G(BARY("DX10"))="ALL" D Q ;P.OTT ;3/12/2014
  1. . S BAR("CONJ")=" "
  1. . S BAR("TXT")="ALL Primary Diagnosis (ICD-9 and ICD-10)"
  1. . D CHK
  1. F BARICDVR="DX9","DX10" D DX01
  1. Q
  1. DX01 I $D(BARY(BARICDVR,1)) D ;P.OTT 3/10/2014
  1. . S BAR("CONJ")="for "
  1. . S BAR("TXT")=$P("Primary;Primary Only;Other Only;ALL (Primary and Other);",";",BARTMP1+1)_" Diagnosis ICD-"_$TR(BARICDVR,"DX") ;P.OTT
  1. . D CHK
  1. . S BAR("CONJ")="from "
  1. . S BAR("TXT")=BARY(BARICDVR,1)
  1. . D CHK
  1. . S BAR("CONJ")="to "
  1. . S BAR("TXT")=BARY(BARICDVR,2)
  1. . D CHK
  1. I $D(BARY(BARICDVR,3)) D
  1. . S BAR("CONJ")="for "
  1. . I $D(BARY(BARICDVR,1)) S BAR("CONJ")="and for "
  1. . S BAR("TXT")="Individual "_$P("Primary;Primary Only;Other Only;ALL (Primary and Other);",";",BARTMP1+1)_" Diagnosis ICD-"_$TR(BARICDVR,"DX") ;P.OTT
  1. . D CHK
  1. . N BARDX,BARAPP
  1. . S BARDX="" F S BARDX=$O(BARY(BARICDVR,3,BARDX)) Q:BARDX="" D
  1. . . S BAR("TXT")=BARDX
  1. . . S BAR("CONJ")=""
  1. . . D CHK
  1. ;-------------------------3/10/2014
  1. I $G(BARY(BARICDVR))="ALL" D ;P.OTT
  1. . S BAR("CONJ")=" "
  1. . S BAR("TXT")="ALL Primary Diagnosis ICD-"_$TR(BARICDVR,"DX") ;P.OTT
  1. . D CHK
  1. ;----------------------------------------
  1. S BAR("TXT")="" ;
  1. S BAR("CONJ")=""
  1. Q
  1. ; ********************************************************************
  1. ;
  1. ITYP ; EP
  1. S BAR("LVL")=0
  1. S BAR("CONJ")="for "
  1. S BAR("TXT")="ALL"
  1. S:$D(BARY("ITYP")) BAR("TXT")=BARY("ITYP","NM")
  1. S BAR("TXT")=BAR("TXT")_" INSURER TYPE(S)"
  1. S BAR("TXT")="" ;
  1. S BAR("CONJ")=""
  1. Q
  1. ;------------------------------------------------------
  1. I BARY("TYP")="^R^MH^MD^MC^MMC^" S BAR("TXT")="MEDICARE" Q
  1. I BARY("TYP")="^D^K^FPL^" S BAR("TXT")="MEDICAID" Q
  1. I BARY("TYP")="^H^M^P^F^" S BAR("TXT")="PRIVATE INSURANCE" Q
  1. I BARY("TYP")="^N^" S BAR("TXT")="NON-BENEFICIARY PATIENTS" Q
  1. I BARY("TYP")="^I^" S BAR("TXT")="BENEFICIARY PATIENTS" Q
  1. I BARY("TYP")="^W^" S BAR("TXT")="WORKMEN'S COMP" Q
  1. I BARY("TYP")="^H^M^P^F^W^" S BAR("TXT")="PRIVATE+WORKMEN'S COMP" Q
  1. I BARY("TYP")="^K^" S BAR("TXT")="CHIP" Q
  1. I BARY("TYP")="^V^" S BAR("TXT")="VETERANS" Q
  1. I BARY("TYP")="^W^C^N^I^T^G^SEP^TSI^" S BAR("TXT")="OTHER" Q
  1. S BAR("TXT")="UNSPECIFIED"
  1. ;eor