ABMURHD.m

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