- ABMURHD ; IHS/ASDST/DMJ - Report Header Generator ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;
- 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
- .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
- .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")="CASHIERING SESSION DATES" D CHK
- 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
- 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
- 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 ;
- Q
- ;
- WHD ;EP for writing Report Header
- W $$EN^ABMVDF("IOF"),!
- D NOW^%DTC
- S Y=$$CDT^ABMDUTL(%)
- 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:50) W Y," Page ",ABM("PG")
- W:$G(ABM("HD",1))]"" !,ABM("HD",1)
- W:$G(ABM("HD",2))]"" !,ABM("HD",2)
- W !,ABM("LINE") K ABM("LINE")
- Q
- ABMURHD ; IHS/ASDST/DMJ - Report Header Generator ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;
- 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 IF ABMY("TYP")="R"
- SET ABM("TXT")="MEDICARE"
- QUIT
- +6 IF ABMY("TYP")="D"
- SET ABM("TXT")="MEDICAID"
- QUIT
- +7 IF ABMY("TYP")="W"
- SET ABM("TXT")="WORKMEN'S COMP"
- QUIT
- +8 IF ABMY("TYP")["W"
- SET ABM("TXT")="PRIVATE+WORKMEN'S COMP"
- QUIT
- +9 IF ABMY("TYP")["P"
- SET ABM("TXT")="PRIVATE INSURANCE"
- QUIT
- +10 IF ABMY("TYP")="N"
- SET ABM("TXT")="NON-BENEFICIARY PATIENTS"
- QUIT
- +11 IF ABMY("TYP")="I"
- SET ABM("TXT")="BENEFICIARY PATIENTS"
- QUIT
- +12 IF ABMY("TYP")="K"
- SET ABM("TXT")="CHIP"
- QUIT
- +13 SET ABM("TXT")="UNSPECIFIED"
- End DoDot:1
- +14 ;
- 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 SET ABM("TXT")="CASHIERING SESSION DATES"
- DO CHK
- +3 SET ABM("CONJ")="from "
- SET ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",1))
- DO CHK
- +4 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 SET ABM("CONJ")="with "
- SET ABM("TXT")="DIAGNOSIS RANGE"
- DO CHK
- +2 SET ABM("CONJ")="from "
- SET ABM("TXT")=ABMY("DX",1)
- DO CHK
- +3 SET ABM("CONJ")="to "
- SET ABM("TXT")=ABMY("DX",2)
- DO CHK
- 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 ;
- +1 QUIT
- +2 ;
- WHD ;EP for writing Report Header
- +1 WRITE $$EN^ABMVDF("IOF"),!
- +2 DO NOW^%DTC
- +3 SET Y=$$CDT^ABMDUTL(%)
- +4 IF $DATA(ABM("PRIVACY"))
- WRITE ?($SELECT($DATA(ABM(132)):34,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
- +5 KILL ABM("LINE")
- SET $PIECE(ABM("LINE"),"=",$SELECT($DATA(ABM(132)):132,1:80))=""
- WRITE ABM("LINE"),!
- +6 WRITE ABM("HD",0),?$SELECT($DATA(ABM(132)):108,1:50)
- WRITE Y," Page ",ABM("PG")
- +7 IF $GET(ABM("HD",1))]""
- WRITE !,ABM("HD",1)
- +8 IF $GET(ABM("HD",2))]""
- WRITE !,ABM("HD",2)
- +9 WRITE !,ABM("LINE")
- KILL ABM("LINE")
- +10 QUIT
