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