- ABMDRHD ; IHS/SD/SDR - Report Header Generator ;
- ;;2.6;IHS Third Party Billing;**1,3,4,11,14,21**;NOV 12, 2009;Build 379
- ;Original;TMD;03/25/96 11:34 AM
- ;
- ;IHS/SD/SDR - v2.5 p8 - Added code for cancellation dates
- ;IHS/SD/SDR - abm*2.6*1 - NO HEAT - Added time to report headers
- ;IHS/SD/SDR - abm*2.6*3 - HEAT12210 - fix header if 132 (was wrapping)
- ;IHS/SD/SDR - abm*2.6*4 - NO HEAT - Fixed header for closed/exported dates
- ;IHS/SD/SDR - 2.6*14 - ICD10 009 - Updated to print ICD10 header
- ;IHS/SD/SDR - 2.6*14 - HEAT165197 (CR3109) - Updated DX tag to display codes using new variables
- ;IHS/SD/SDR - 2.6*21 - HEAT184442 - Adeed ICD-10 to header when ICD-10 Diagnosis Range is selected; wasn't clear before when only
- ; DIAGNOSIS RANGE was displayed. Also updated header so if they select BOTH but don't enter anything for ICD-9, it won't print the
- ; 'and' and will only print the ICD-10 range selected.
- ;IHS/SD/SDR - 2.6*21 - VMBP RQMT_96 - Added code for all new insurer types.
- ;
- HD ;EP for setting Report Header
- S ABM("LVL")=0,ABM("CONJ")="for ",ABM("TXT")="ALL BILLING SOURCES"
- I $D(ABMY("INS")) S ABM("TXT")=$P(^AUTNINS(ABMY("INS"),0),U) G LOC
- I $D(ABMY("PAT")) S ABM("TXT")=$P(^DPT(ABMY("PAT"),0),U) G LOC
- I $D(ABMY("TYP")) D
- .;start old abm*2.6*21 IHS/SD/SDR VMBP RQMT_96
- .;I ABMY("TYP")="R" S ABM("TXT")="MEDICARE" Q
- .;I ABMY("TYP")="D" S ABM("TXT")="MEDICAID" Q
- .;I ABMY("TYP")="W" S ABM("TXT")="WORKMEN'S COMP" Q
- .;I ABMY("TYP")["W" S ABM("TXT")="PRIVATE+WORKMEN'S COMP" Q
- .;I ABMY("TYP")["P" S ABM("TXT")="PRIVATE INSURANCE" Q
- .;I ABMY("TYP")="N" S ABM("TXT")="NON-BENEFICIARY PATIENTS" Q
- .;I ABMY("TYP")="I" S ABM("TXT")="BENEFICIARY PATIENTS" Q
- .;I ABMY("TYP")="K" S ABM("TXT")="CHIP" Q
- .;I ABMY("TYP")="V" S ABM("TXT")="VETERANS ADMINISTRATION" Q ;abm*2.6*11 VMBP RQMT_96
- .;end old start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_96
- .I ABMY("TYP")["^R^" S ABM("TXT")="MEDICARE" Q
- .I ABMY("TYP")="^D^" S ABM("TXT")="MEDICAID" Q
- .I ABMY("TYP")="^W^" S ABM("TXT")="WORKMEN'S COMP" Q
- .I ABMY("TYP")["W" S ABM("TXT")="PRIVATE+WORKMEN'S COMP" Q
- .I ABMY("TYP")["P" S ABM("TXT")="PRIVATE INSURANCE" Q
- .I ABMY("TYP")="^N^" S ABM("TXT")="NON-BENEFICIARY PATIENTS" Q
- .I ABMY("TYP")="^I^" S ABM("TXT")="BENEFICIARY PATIENTS" Q
- .I ABMY("TYP")="^K^" S ABM("TXT")="CHIP" Q
- .I ABMY("TYP")="^V^" S ABM("TXT")="VETERANS ADMINISTRATION" Q
- .I ABMY("TYP")="^FPL^" S ABM("TXT")="FPL 133 PERCENT" Q
- .I ABMY("TYP")="^SEP^" S ABM("TXT")="STATE EXCHANGE PLAN" Q
- .I ABMY("TYP")="^T^" S ABM("TXT")="3P LIABILITY" Q
- .I ABMY("TYP")="^MH^" S ABM("TXT")="MEDICARE HMO" Q
- .I ABMY("TYP")="^TSI^" S ABM("TXT")="TRIBAL SELF INSURED" Q
- .;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_96
- .S ABM("TXT")="UNSPECIFIED"
- ;
- LOC ;EP
- D CHK I $D(ABMY("LOC")) S ABM("TXT")=$P(^DIC(4,ABMY("LOC"),0),U),ABM("CONJ")="at " D CHK
- DT I '$D(ABMY("DT")) G APPR
- S ABM("CONJ")="with "
- ;S ABM("TXT")=$S(ABMY("DT")="A":"APPROVAL DATES",ABMY("DT")="V":"VISIT DATES",ABMY("DT")="P":"PAYMENT DATES",ABMY("DT")="C":"CANCELLATION DATES",ABMY("DT")="X":"CLOSED DATES",1:"EXPORT DATES") D CHK ;abm*2.6*4 NOHEAT
- S ABM("TXT")=$S(ABMY("DT")="A":"APPROVAL DATES",ABMY("DT")="V":"VISIT DATES",ABMY("DT")="P":"PAYMENT DATES",ABMY("DT")="C":"CANCELLATION DATES",ABMY("DT")="M":"CLOSED DATES",1:"EXPORT DATES") D CHK ;abm*2.6*4 NOHEAT
- S ABM("CONJ")="from ",ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",1)) D CHK
- S ABM("CONJ")="to ",ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",2)) D CHK
- APPR I '$D(ABM("APPR")),$D(ABMY("APPR")) S ABM("CONJ")="by ",ABM("TXT")=$P(^VA(200,ABMY("APPR"),0),U) D CHK
- PRV I $D(ABMY("PRV")) S ABM("CONJ")="provided by ",ABM("TXT")=$P(^VA(200,ABMY("PRV"),0),U) D CHK
- DX I '$D(ABMY("DX")) G PX
- ;start old code abm*2.6*14 ICD10 009
- ;S ABM("CONJ")="with ",ABM("TXT")="DIAGNOSIS RANGE" D CHK
- ;S ABM("CONJ")="from ",ABM("TXT")=ABMY("DX",1) D CHK
- ;S ABM("CONJ")="to ",ABM("TXT")=ABMY("DX",2) D CHK
- ;end old code start new code ICD10 009 and HEAT165197 (CR3109)
- ;S ABM("CONJ")="with ",ABM("TXT")=$S($G(ABMY("DXANS"))=9:"ICD-9 ",$D(ABMY("DXANS"))=10:"ICD-10 ",1:"")_"DIAGNOSIS RANGE" D CHK ;abm*2.6*21 IHS/SD/SDR HEAT184442
- S ABM("CONJ")="with ",ABM("TXT")=$S($G(ABMY("DXANS"))=9:"ICD-9 ",$G(ABMY("DXANS"))=10:"ICD-10 ",1:"")_"DIAGNOSIS RANGE" D CHK ;abm*2.6*21 IHS/SD/SDR HEAT184442 - corrected to make ICD-10 print in header
- I $D(ABMY("DX",1)) D
- .S ABM("CONJ")=$S($G(ABMY("DXANS"))="B":"ICD-9s ",1:"from "),ABM("TXT")=ABM("DX",1) D CHK
- .S ABM("CONJ")="to ",ABM("TXT")=ABM("DX",2) D CHK
- I $D(ABMY("DX",3)) D
- .;S ABM("CONJ")=$S($G(ABMY("DXANS"))="B":"and ICD-10s ",1:"from "),ABM("TXT")=ABM("DX",3) D CHK ;abm*2.6*21 IHS/SD/SDR HEAT184442
- .S ABM("CONJ")=$S(($G(ABMY("DXANS"))="B"&($D(ABM("DX",1)))):"and ",1:"ICD-10s from "),ABM("TXT")=ABM("DX",3) D CHK ;abm*2.6*21 IHS/SD/SDR HEAT184442 - remove 'and' if no ICD-9 range selected
- .S ABM("CONJ")="to ",ABM("TXT")=ABM("DX",4) D CHK
- ;end new code ICD10 009 and HEAT165197 (CR3109)
- PX I '$D(ABMY("PX")) G XIT
- S ABM("CONJ")="with ",ABM("TXT")="PROCEDURE RANGE" D CHK
- S ABM("CONJ")="from ",ABM("TXT")=ABMY("PX",1) D CHK
- S ABM("CONJ")="to ",ABM("TXT")=ABMY("PX",2) D CHK
- ;
- XIT K ABM("CONJ"),ABM("TXT"),ABM("LVL")
- Q
- ;
- CHK I ($L(ABM("HD",ABM("LVL")))+1+$L(ABM("CONJ"))+$L(ABM("TXT")))<($S($D(ABM(132)):104,1:52)+$S(ABM("LVL")>0:28,1:0)) S ABM("HD",ABM("LVL"))=ABM("HD",ABM("LVL"))_" "_ABM("CONJ")_ABM("TXT")
- E S ABM("LVL")=ABM("LVL")+1,ABM("HD",ABM("LVL"))=ABM("CONJ")_ABM("TXT")
- Q
- ;
- WHD ;EP for writing Report Header
- W $$EN^ABMVDF("IOF"),!
- I $D(ABM("PRIVACY")) W ?($S($D(ABM(132)):34,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
- K ABM("LINE") S $P(ABM("LINE"),"=",$S($D(ABM(132)):132,1:80))="" W ABM("LINE"),!
- ;W ABM("HD",0),?$S($D(ABM(132)):108,1:57) S Y=DT X ^DD("DD") W Y," Page ",ABM("PG") ;abm*2.6*1 NO HEAT
- D NOW^%DTC ;abm*2.6*1 NO HEAT
- ;W ABM("HD",0),?$S($D(ABM(132)):108,1:48) S Y=% X ^DD("DD") W Y," Page ",ABM("PG") ;abm*2.6*1 NO HEAT ;abm*2.6*3 HEAT12210
- W ABM("HD",0),?$S($D(ABM(132)):103,1:48) S Y=% X ^DD("DD") W Y," Page ",ABM("PG") ;abm*2.6*1 NO HEAT ;abm*2.6*3 HEAT12210
- W:$G(ABM("HD",1))]"" !,ABM("HD",1)
- W:$G(ABM("HD",2))]"" !,ABM("HD",2)
- W !,"Billing Location: ",$P($G(^AUTTLOC(DUZ(2),0)),U,2)
- W !,ABM("LINE") K ABM("LINE")
- Q
- ABMDRHD ; IHS/SD/SDR - Report Header Generator ;
- +1 ;;2.6;IHS Third Party Billing;**1,3,4,11,14,21**;NOV 12, 2009;Build 379
- +2 ;Original;TMD;03/25/96 11:34 AM
- +3 ;
- +4 ;IHS/SD/SDR - v2.5 p8 - Added code for cancellation dates
- +5 ;IHS/SD/SDR - abm*2.6*1 - NO HEAT - Added time to report headers
- +6 ;IHS/SD/SDR - abm*2.6*3 - HEAT12210 - fix header if 132 (was wrapping)
- +7 ;IHS/SD/SDR - abm*2.6*4 - NO HEAT - Fixed header for closed/exported dates
- +8 ;IHS/SD/SDR - 2.6*14 - ICD10 009 - Updated to print ICD10 header
- +9 ;IHS/SD/SDR - 2.6*14 - HEAT165197 (CR3109) - Updated DX tag to display codes using new variables
- +10 ;IHS/SD/SDR - 2.6*21 - HEAT184442 - Adeed ICD-10 to header when ICD-10 Diagnosis Range is selected; wasn't clear before when only
- +11 ; DIAGNOSIS RANGE was displayed. Also updated header so if they select BOTH but don't enter anything for ICD-9, it won't print the
- +12 ; 'and' and will only print the ICD-10 range selected.
- +13 ;IHS/SD/SDR - 2.6*21 - VMBP RQMT_96 - Added code for all new insurer types.
- +14 ;
- HD ;EP for setting Report Header
- +1 SET ABM("LVL")=0
- SET ABM("CONJ")="for "
- SET ABM("TXT")="ALL BILLING SOURCES"
- +2 IF $DATA(ABMY("INS"))
- SET ABM("TXT")=$PIECE(^AUTNINS(ABMY("INS"),0),U)
- GOTO LOC
- +3 IF $DATA(ABMY("PAT"))
- SET ABM("TXT")=$PIECE(^DPT(ABMY("PAT"),0),U)
- GOTO LOC
- +4 IF $DATA(ABMY("TYP"))
- Begin DoDot:1
- +5 ;start old abm*2.6*21 IHS/SD/SDR VMBP RQMT_96
- +6 ;I ABMY("TYP")="R" S ABM("TXT")="MEDICARE" Q
- +7 ;I ABMY("TYP")="D" S ABM("TXT")="MEDICAID" Q
- +8 ;I ABMY("TYP")="W" S ABM("TXT")="WORKMEN'S COMP" Q
- +9 ;I ABMY("TYP")["W" S ABM("TXT")="PRIVATE+WORKMEN'S COMP" Q
- +10 ;I ABMY("TYP")["P" S ABM("TXT")="PRIVATE INSURANCE" Q
- +11 ;I ABMY("TYP")="N" S ABM("TXT")="NON-BENEFICIARY PATIENTS" Q
- +12 ;I ABMY("TYP")="I" S ABM("TXT")="BENEFICIARY PATIENTS" Q
- +13 ;I ABMY("TYP")="K" S ABM("TXT")="CHIP" Q
- +14 ;I ABMY("TYP")="V" S ABM("TXT")="VETERANS ADMINISTRATION" Q ;abm*2.6*11 VMBP RQMT_96
- +15 ;end old start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_96
- +16 IF ABMY("TYP")["^R^"
- SET ABM("TXT")="MEDICARE"
- QUIT
- +17 IF ABMY("TYP")="^D^"
- SET ABM("TXT")="MEDICAID"
- QUIT
- +18 IF ABMY("TYP")="^W^"
- SET ABM("TXT")="WORKMEN'S COMP"
- QUIT
- +19 IF ABMY("TYP")["W"
- SET ABM("TXT")="PRIVATE+WORKMEN'S COMP"
- QUIT
- +20 IF ABMY("TYP")["P"
- SET ABM("TXT")="PRIVATE INSURANCE"
- QUIT
- +21 IF ABMY("TYP")="^N^"
- SET ABM("TXT")="NON-BENEFICIARY PATIENTS"
- QUIT
- +22 IF ABMY("TYP")="^I^"
- SET ABM("TXT")="BENEFICIARY PATIENTS"
- QUIT
- +23 IF ABMY("TYP")="^K^"
- SET ABM("TXT")="CHIP"
- QUIT
- +24 IF ABMY("TYP")="^V^"
- SET ABM("TXT")="VETERANS ADMINISTRATION"
- QUIT
- +25 IF ABMY("TYP")="^FPL^"
- SET ABM("TXT")="FPL 133 PERCENT"
- QUIT
- +26 IF ABMY("TYP")="^SEP^"
- SET ABM("TXT")="STATE EXCHANGE PLAN"
- QUIT
- +27 IF ABMY("TYP")="^T^"
- SET ABM("TXT")="3P LIABILITY"
- QUIT
- +28 IF ABMY("TYP")="^MH^"
- SET ABM("TXT")="MEDICARE HMO"
- QUIT
- +29 IF ABMY("TYP")="^TSI^"
- SET ABM("TXT")="TRIBAL SELF INSURED"
- QUIT
- +30 ;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_96
- +31 SET ABM("TXT")="UNSPECIFIED"
- End DoDot:1
- +32 ;
- LOC ;EP
- +1 DO CHK
- IF $DATA(ABMY("LOC"))
- SET ABM("TXT")=$PIECE(^DIC(4,ABMY("LOC"),0),U)
- SET ABM("CONJ")="at "
- DO CHK
- DT IF '$DATA(ABMY("DT"))
- GOTO APPR
- +1 SET ABM("CONJ")="with "
- +2 ;S ABM("TXT")=$S(ABMY("DT")="A":"APPROVAL DATES",ABMY("DT")="V":"VISIT DATES",ABMY("DT")="P":"PAYMENT DATES",ABMY("DT")="C":"CANCELLATION DATES",ABMY("DT")="X":"CLOSED DATES",1:"EXPORT DATES") D CHK ;abm*2.6*4 NOHEAT
- +3 ;abm*2.6*4 NOHEAT
- SET ABM("TXT")=$SELECT(ABMY("DT")="A":"APPROVAL DATES",ABMY("DT")="V":"VISIT DATES",ABMY("DT")="P":"PAYMENT DATES",ABMY("DT")="C":"CANCELLATION DATES",ABMY("DT")="M":"CLOSED DATES",1:"EXPORT DATES")
- DO CHK
- +4 SET ABM("CONJ")="from "
- SET ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",1))
- DO CHK
- +5 SET ABM("CONJ")="to "
- SET ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",2))
- DO CHK
- APPR IF '$DATA(ABM("APPR"))
- IF $DATA(ABMY("APPR"))
- SET ABM("CONJ")="by "
- SET ABM("TXT")=$PIECE(^VA(200,ABMY("APPR"),0),U)
- DO CHK
- PRV IF $DATA(ABMY("PRV"))
- SET ABM("CONJ")="provided by "
- SET ABM("TXT")=$PIECE(^VA(200,ABMY("PRV"),0),U)
- DO CHK
- DX IF '$DATA(ABMY("DX"))
- GOTO PX
- +1 ;start old code abm*2.6*14 ICD10 009
- +2 ;S ABM("CONJ")="with ",ABM("TXT")="DIAGNOSIS RANGE" D CHK
- +3 ;S ABM("CONJ")="from ",ABM("TXT")=ABMY("DX",1) D CHK
- +4 ;S ABM("CONJ")="to ",ABM("TXT")=ABMY("DX",2) D CHK
- +5 ;end old code start new code ICD10 009 and HEAT165197 (CR3109)
- +6 ;S ABM("CONJ")="with ",ABM("TXT")=$S($G(ABMY("DXANS"))=9:"ICD-9 ",$D(ABMY("DXANS"))=10:"ICD-10 ",1:"")_"DIAGNOSIS RANGE" D CHK ;abm*2.6*21 IHS/SD/SDR HEAT184442
- +7 ;abm*2.6*21 IHS/SD/SDR HEAT184442 - corrected to make ICD-10 print in header
- SET ABM("CONJ")="with "
- SET ABM("TXT")=$SELECT($GET(ABMY("DXANS"))=9:"ICD-9 ",$GET(ABMY("DXANS"))=10:"ICD-10 ",1:"")_"DIAGNOSIS RANGE"
- DO CHK
- +8 IF $DATA(ABMY("DX",1))
- Begin DoDot:1
- +9 SET ABM("CONJ")=$SELECT($GET(ABMY("DXANS"))="B":"ICD-9s ",1:"from ")
- SET ABM("TXT")=ABM("DX",1)
- DO CHK
- +10 SET ABM("CONJ")="to "
- SET ABM("TXT")=ABM("DX",2)
- DO CHK
- End DoDot:1
- +11 IF $DATA(ABMY("DX",3))
- Begin DoDot:1
- +12 ;S ABM("CONJ")=$S($G(ABMY("DXANS"))="B":"and ICD-10s ",1:"from "),ABM("TXT")=ABM("DX",3) D CHK ;abm*2.6*21 IHS/SD/SDR HEAT184442
- +13 ;abm*2.6*21 IHS/SD/SDR HEAT184442 - remove 'and' if no ICD-9 range selected
- SET ABM("CONJ")=$SELECT(($GET(ABMY("DXANS"))="B"&($DATA(ABM("DX",1)))):"and ",1:"ICD-10s from ")
- SET ABM("TXT")=ABM("DX",3)
- DO CHK
- +14 SET ABM("CONJ")="to "
- SET ABM("TXT")=ABM("DX",4)
- DO CHK
- End DoDot:1
- +15 ;end new code ICD10 009 and HEAT165197 (CR3109)
- PX IF '$DATA(ABMY("PX"))
- GOTO XIT
- +1 SET ABM("CONJ")="with "
- SET ABM("TXT")="PROCEDURE RANGE"
- DO CHK
- +2 SET ABM("CONJ")="from "
- SET ABM("TXT")=ABMY("PX",1)
- DO CHK
- +3 SET ABM("CONJ")="to "
- SET ABM("TXT")=ABMY("PX",2)
- DO CHK
- +4 ;
- XIT KILL ABM("CONJ"),ABM("TXT"),ABM("LVL")
- +1 QUIT
- +2 ;
- CHK IF ($LENGTH(ABM("HD",ABM("LVL")))+1+$LENGTH(ABM("CONJ"))+$LENGTH(ABM("TXT")))<($SELECT($DATA(ABM(132)):104,1:52)+$SELECT(ABM("LVL")>0:28,1:0))
- SET ABM("HD",ABM("LVL"))=ABM("HD",ABM("LVL"))_" "_ABM("CONJ")_ABM("TXT")
- +1 IF '$TEST
- SET ABM("LVL")=ABM("LVL")+1
- SET ABM("HD",ABM("LVL"))=ABM("CONJ")_ABM("TXT")
- +2 QUIT
- +3 ;
- WHD ;EP for writing Report Header
- +1 WRITE $$EN^ABMVDF("IOF"),!
- +2 IF $DATA(ABM("PRIVACY"))
- WRITE ?($SELECT($DATA(ABM(132)):34,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
- +3 KILL ABM("LINE")
- SET $PIECE(ABM("LINE"),"=",$SELECT($DATA(ABM(132)):132,1:80))=""
- WRITE ABM("LINE"),!
- +4 ;W ABM("HD",0),?$S($D(ABM(132)):108,1:57) S Y=DT X ^DD("DD") W Y," Page ",ABM("PG") ;abm*2.6*1 NO HEAT
- +5 ;abm*2.6*1 NO HEAT
- DO NOW^%DTC
- +6 ;W ABM("HD",0),?$S($D(ABM(132)):108,1:48) S Y=% X ^DD("DD") W Y," Page ",ABM("PG") ;abm*2.6*1 NO HEAT ;abm*2.6*3 HEAT12210
- +7 ;abm*2.6*1 NO HEAT ;abm*2.6*3 HEAT12210
- WRITE ABM("HD",0),?$SELECT($DATA(ABM(132)):103,1:48)
- SET Y=%
- XECUTE ^DD("DD")
- WRITE Y," Page ",ABM("PG")
- +8 IF $GET(ABM("HD",1))]""
- WRITE !,ABM("HD",1)
- +9 IF $GET(ABM("HD",2))]""
- WRITE !,ABM("HD",2)
- +10 WRITE !,"Billing Location: ",$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)
- +11 WRITE !,ABM("LINE")
- KILL ABM("LINE")
- +12 QUIT
