ABMDRSU1.m

ABMDRSU1 ; IHS/ASDST/DMJ - Summarized Claim Display ; 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;

VAR S U="^" K ABM

START ;

 S ABM("80E")="==============================================================================="

 S ABM("80D")="-------------------------------------------------------------------------------"

 K ABMP("QUIT")

 D DFN

 Q

DFN ;

 S ABM("ERR")=0

 Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),0))

 S ABM("PDFN")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,1),ABM("LOC")=$P(^(0),U,3),ABM("VD")=$P(^(0),U,2),ABM("CLN")=$P(^(0),U,6)

 S:ABM("LOC")="" ABM("LOC")=DUZ(2)

 I ABM("CLN")]"",$D(^DIC(40.7,ABM("CLN"),0)) S ABM("CLN")=$P(^(0),U,1)

 S ABM("PN")=$P(^DPT(ABM("PDFN"),0),U)

 S ABM("VD")=$$SDT^ABMDUTL(ABM("VD"))

 I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),$P(^(6),U,3)]"" S Y=$P(^(6),U,3),ABM("DD")=$$SDT^ABMDUTL(Y)

 E  S ABM("DD")=""

 I 'ABMP("PG") D HEAD1

 I $Y>(IOSL-10) D HEAD Q:$D(ABMP("QUIT"))

 D HD

 ;

VST S ABM("VTYPE")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7)

 S ABM("VTYPE")=$S(ABM("VTYPE")="H":"HOME HLTH",ABM("VTYPE")="I":"INPATIENT",ABM("VTYPE")="D":"DENTAL",ABM("VTYPE")="S":"O/P SURGERY",1:"OUTPATIENT")

 W !!?5,"Visit",?14,"Discharge" ;,?32,"Visit",?72,"Visit"

 W !?6,"Date",?16,"Date",?26,"Location",?48,"Clinic",?68,"Type"

 W !?4 F I=1:1:75 W "-"

 W !?3,ABM("VD"),?14,ABM("DD"),?26,$P(^AUTTLOC(ABM("LOC"),0),U,2),?48,$E(ABM("CLN"),1,14),?68,$E(ABM("VTYPE"),1,10)

 ;

 D ^ABMDRSU2

 Q

 ;

HD ;EP to print mid header

 S ABM("HRN")="no HRN here",ABM("SSN")="    none"

 S (ABM("DOB"),Y)=$P(^DPT(ABM("PDFN"),0),U,3) I ABM("DOB")]"" X ^DD("DD") S ABM("DOB")=Y

 I $D(^AUPNPAT(ABM("PDFN"),41,ABM("LOC"),0)) S ABM("HRN")=$P(^AUPNPAT(ABM("PDFN"),41,ABM("LOC"),0),U,2)

 S ABM("SSN")=$P(^DPT(ABM("PDFN"),0),U,9) I ABM("SSN")]"" S ABM("SSN")=$E(ABM("SSN"),1,3)_"-"_$E(ABM("SSN"),4,5)_"-"_$E(ABM("SSN"),6,9)

 W !,ABM("PN")

 I '$D(ABM("CONT")) W "  (",ABM("HRN"),")",?38,ABMP("CDFN"),?50,ABM("DOB"),?66,ABM("SSN")

 E  W "   (continued from previous page)"

 K ABM("CONT")

 Q

HEAD ;EP to print header

 I 'ABMP("PG") G HEAD1

 I $E(IOST)="C",'$D(IO("S")) W ! K DIR,%P S DIR(0)="EO" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S ABMP("QUIT")="" Q

HEAD1 ;

 W $$EN^ABMVDF("IOF") S ABMP("PG")=ABMP("PG")+1

 I $E(IOST)="P" W !

 W ?6,"  ",$$SDT^ABMDUTL(DT)

 W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?(64-$L(ABMP("PG"))),"Page: ",ABMP("PG"),"  "

 I $D(ABMP("HEAD2")) S ABM("LENG")=$L(ABMP("HEAD2")) W !?6,?((80-ABM("LENG"))/2),ABMP("HEAD2"),?70,"  "

 I $D(ABMP("HEAD3")) S ABM("LENG")=$L(ABMP("HEAD3")) W !?6,?((80-ABM("LENG"))/2),ABMP("HEAD3"),?70,"  ",!

 W !,"Patient Name  (HRN)",?37,"CLM #",?48,"Date of Birth",?70,"SSN"

 W !,ABM("80E")

 Q

ABMDRSU1  ; IHS/ASDST/DMJ - Summarized Claim Display ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;TMD;

VAR        SET U="^"

           KILL ABM

START     ;

 +1        SET ABM("80E")="==============================================================================="

 +2        SET ABM("80D")="-------------------------------------------------------------------------------"

 +3        KILL ABMP("QUIT")

 +4        DO DFN

 +5        QUIT 

DFN       ;

 +1        SET ABM("ERR")=0

 +2        IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),0))

               QUIT 

 +3        SET ABM("PDFN")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,1)

           SET ABM("LOC")=$PIECE(^(0),U,3)

           SET ABM("VD")=$PIECE(^(0),U,2)

           SET ABM("CLN")=$PIECE(^(0),U,6)

 +4        IF ABM("LOC")=""

               SET ABM("LOC")=DUZ(2)

 +5        IF ABM("CLN")]""

               IF $DATA(^DIC(40.7,ABM("CLN"),0))

                   SET ABM("CLN")=$PIECE(^(0),U,1)

 +6        SET ABM("PN")=$PIECE(^DPT(ABM("PDFN"),0),U)

 +7        SET ABM("VD")=$$SDT^ABMDUTL(ABM("VD"))

 +8        IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),6))

               IF $PIECE(^(6),U,3)]""

                   SET Y=$PIECE(^(6),U,3)

                   SET ABM("DD")=$$SDT^ABMDUTL(Y)

 +9       IF '$TEST

               SET ABM("DD")=""

 +10       IF 'ABMP("PG")

               DO HEAD1

 +11       IF $Y>(IOSL-10)

               DO HEAD

               IF $DATA(ABMP("QUIT"))

                   QUIT 

 +12       DO HD

 +13      ;

VST        SET ABM("VTYPE")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7)

 +1        SET ABM("VTYPE")=$SELECT(ABM("VTYPE")="H":"HOME HLTH",ABM("VTYPE")="I":"INPATIENT",ABM("VTYPE")="D":"DENTAL",ABM("VTYPE")="S":"O/P SURGERY",1:"OUTPATIENT")

 +2       ;,?32,"Visit",?72,"Visit"

           WRITE !!?5,"Visit",?14,"Discharge"

 +3        WRITE !?6,"Date",?16,"Date",?26,"Location",?48,"Clinic",?68,"Type"

 +4        WRITE !?4

           FOR I=1:1:75

               WRITE "-"

 +5        WRITE !?3,ABM("VD"),?14,ABM("DD"),?26,$PIECE(^AUTTLOC(ABM("LOC"),0),U,2),?48,$EXTRACT(ABM("CLN"),1,14),?68,$EXTRACT(ABM("VTYPE"),1,10)

 +6       ;

 +7        DO ^ABMDRSU2

 +8        QUIT 

 +9       ;

HD        ;EP to print mid header

 +1        SET ABM("HRN")="no HRN here"

           SET ABM("SSN")="    none"

 +2        SET (ABM("DOB"),Y)=$PIECE(^DPT(ABM("PDFN"),0),U,3)

           IF ABM("DOB")]""

               XECUTE ^DD("DD")

               SET ABM("DOB")=Y

 +3        IF $DATA(^AUPNPAT(ABM("PDFN"),41,ABM("LOC"),0))

               SET ABM("HRN")=$PIECE(^AUPNPAT(ABM("PDFN"),41,ABM("LOC"),0),U,2)

 +4        SET ABM("SSN")=$PIECE(^DPT(ABM("PDFN"),0),U,9)

           IF ABM("SSN")]""

               SET ABM("SSN")=$EXTRACT(ABM("SSN"),1,3)_"-"_$EXTRACT(ABM("SSN"),4,5)_"-"_$EXTRACT(ABM("SSN"),6,9)

 +5        WRITE !,ABM("PN")

 +6        IF '$DATA(ABM("CONT"))

               WRITE "  (",ABM("HRN"),")",?38,ABMP("CDFN"),?50,ABM("DOB"),?66,ABM("SSN")

 +7       IF '$TEST

               WRITE "   (continued from previous page)"

 +8        KILL ABM("CONT")

 +9        QUIT 

HEAD      ;EP to print header

 +1        IF 'ABMP("PG")

               GOTO HEAD1

 +2        IF $EXTRACT(IOST)="C"

               IF '$DATA(IO("S"))

                   WRITE !

                   KILL DIR,%P

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIROUT))

                       SET ABMP("QUIT")=""

                       QUIT 

HEAD1     ;

 +1        WRITE $$EN^ABMVDF("IOF")

           SET ABMP("PG")=ABMP("PG")+1

 +2        IF $EXTRACT(IOST)="P"

               WRITE !

 +3        WRITE ?6,"  ",$$SDT^ABMDUTL(DT)

 +4        WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?(64-$LENGTH(ABMP("PG"))),"Page: ",ABMP("PG"),"  "

 +5        IF $DATA(ABMP("HEAD2"))

               SET ABM("LENG")=$LENGTH(ABMP("HEAD2"))

               WRITE !?6,?((80-ABM("LENG"))/2),ABMP("HEAD2"),?70,"  "

 +6        IF $DATA(ABMP("HEAD3"))

               SET ABM("LENG")=$LENGTH(ABMP("HEAD3"))

               WRITE !?6,?((80-ABM("LENG"))/2),ABMP("HEAD3"),?70,"  ",!

 +7        WRITE !,"Patient Name  (HRN)",?37,"CLM #",?48,"Date of Birth",?70,"SSN"

 +8        WRITE !,ABM("80E")

 +9        QUIT