ABMDECK.m

ABMDECK ; IHS/ASDST/DMJ - Check Claim Data for Errors ; 

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

 ;

 ;IHS/SD/EFG - V2.5 P8 - IM16385

 ;   Modified to display page 8H for visit type 998

 ;

 K ABMC

SEL K DIR S DIR(0)="S^1:DETAILED CLAIM LISTING;2:ERROR LISTING ONLY"_$S($O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0)):";3:PCC VISIT DISPLAY;4:HEALTH SUMMARY",$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,0)):";3:APC VISIT DISPLAY",1:"")

 S DIR("A")="Enter DESIRED REPORT",DIR("B")=2 D ^DIR

 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT

 I Y=1 S ABMP("DDL")="" G START

 I Y=2 S ABMP("ERROR LIST")="" G START

 I Y=3,$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0)) D  G XIT

 .S ABMC=0 F  S ABMC=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMC)) Q:'ABMC  S ABMDVDSP=ABMC D ^ABMDVDSP

 I Y=3,$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,0)) D  G XIT

 .S ABMC=0 F  S ABMC=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,ABMC)) Q:'ABMC  S ABMDADSP=ABMC D ^ABMDADSP

 I Y=4 S APCHSTYP=$O(^APCHSCTL("B","ADULT REGULAR",0)),APCHSPAT=ABMP("PDFN") I APCHSTYP D EN^APCHS K DIR S DIR(0)="E" D ^DIR K APCHSTYP,APCHSPAT G XIT

 W *7 G SEL

START S ABMP("PG")=0,ABMP("HEAD2")="CLAIM DATA ERRORS"

ZIS W !! S %ZIS("A")="Output DEVICE: ",%ZIS="NQ" D ^%ZIS

 I IO'=IO(0) D  Q

 .S ZTRTN="ENT^ABMDECK",ZTDESC="3P BILLING CLAIM DATA-CHECK/DISPLAY"

 .S ZTSAVE("ABMP(")=""

 .D ^%ZTLOAD

 .W:$G(ZTSK) "(Job Queued, Task Number: ",ZTSK,")"

 .D HOME^%ZIS

 .K ABMP("DDL"),ABMP("ERROR LIST")

 I $D(IO("S")) S IOP=ION D ^%ZIS

 G BEGIN

 ;

ENT ;EP - TaskMan Entry Point

 S ABMC("QUEON")=""

BEGIN S ABMC("CTR")=0

 S ABMC("ERR")=0

 I '$D(ABMP("DDL")) G ERRIN

 S ABMD("CTR")=0,ABMC("DDL")="",ABMP("SCRN")=1,ABMP("RTN")="^ABMDE1"

 D ^ABMDEVAR,SCRN^ABMDE

 K ABMP("QUIT"),DIROUT,DTOUT,DUOUT,DIR G DONE

 ;

ERRIN ;EP - for Claim Error Listing

 S (ABMC("CTR"),ABMC("ERR"),ABMP("CHK"))=0

 S ABMZ("PG")="E",ABMZ("TITL")="ERROR LISTING" I '$D(ABMC("QUE")),'$G(ABMQUIET) D SUM^ABMDE1

 ;

 S (ABMC("I"),ABMC("J"))=1,ABMC("K")="ERR"

LOOP ;LOOP

 I '$G(ABMQUIET) D

 .Q:'($Y>(IOSL-5))

 .S ABMC("DO")=$S('$D(ABMC("QUE")):"EOP^ABMDERR",1:"EOP") D @ABMC("DO")

 I $D(DUOUT)!$D(DIROUT)!$D(DTOUT) G DONE

 K ABME

 S ABMC=$P(ABMP("PAGE"),",",ABMC("I")) G DONE:ABMC="" I $D(ABMC("E0")),ABMC("CTR")>0 G DONE

 I ABMC=0 D  G LOOP

 .S ABMC("I")=ABMC("I")+1

 .D ^ABMDE0X

 .I +$O(ABME(0)) S ABME("CHK")="",ABMC("DO")=$S($D(ABMC("QUE")):"QUE^ABMDERR",$G(ABMQUIET):"QUE^ABMDERR",1:"^ABMDERR") D @ABMC("DO")

 I ABMC=5 S ABMC("K")=$P("A,B",",",ABMC("J"))

 I ABMC=8 S ABMC("K")=$P("A,B,C,D,E,F,G,H",",",ABMC("J")) G INCR:ABMP("BTYP")=831&$D(ABMP("FLAT"))&(ABMC("K")'="B"),INCR:ABMP("VTYP")=998&("DEFH"'[ABMC("K"))

 I ABMC=9 S ABMC("K")=$P("A,B,C,D,E,F",",",ABMC("J"))

 D @(ABMC("K")_"^ABMDE"_ABMC_"X")

INCR I ABMC=5 S ABMC("J")=$S(ABMC("K")="B":1,1:ABMC("J")+1),ABMC("I")=$S(ABMC("K")="B":ABMC("I")+1,1:ABMC("I")) S:ABMC("J")=1 ABMC("K")="ERR" G CHK

 I ABMC=8 S ABMC("I")=$S(ABMC("K")="H":ABMC("I")+1,1:ABMC("I")),ABMC("J")=$S(ABMC("K")="H":1,1:ABMC("J")+1) G CHK

 I ABMC=9 S ABMC("I")=$S(ABMC("K")="F":0,1:ABMC("I")),ABMC("J")=$S(ABMC("I")=0:0,1:ABMC("J")+1) G CHK

 S ABMC("I")=ABMC("I")+1

CHK I +$O(ABME(0)) S ABME("CHK")="",ABMC("DO")=$S($D(ABMC("QUE")):"QUE^ABMDERR",$G(ABMQUIET):"QUE^ABMDERR",1:"^ABMDERR") D @ABMC("DO")

 I ABMC=0 G DONE

 G LOOP

DONE ;DONE WITH LOOP

 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")

 S DR=".05////"_ABMC("CTR") D ^DIE

 I $G(ABMQUIET) G XIT

 I $D(ABMP("DDL"))!($D(ABMP("ERROR LIST"))) W !!,"(End of Report)"

 I IO'=IO(0)!($E(IOST)'="C")!($D(IO("S"))) W $$EN^ABMVDF("IOF") D ^%ZISC I 1

 E  I $D(ABMP("DDL"))!$D(ABMP("ERROR LIST")) K DIR S DIR(0)="E" D ^DIR K DIR

 I $D(ABMC("E0")) Q

 I $D(ABMC("QUEON")) G XIT

 I $D(ABMP("DDL")) G XIT

 ;

ERR I ABMC("CTR")>0 W !!,*7,"  =========================================================================== "

 I  W !,"    Fatal ERRORS Exist a Bill can not be Generated until they are Resolved!    "

 I  W !,"  =========================================================================== ",! D HLP^ABMDERR

 ;

 ;

XIT K ABM,ABMC,POP,ZTSK,DIRUT,DTOUT,IO("Q"),DIR,DIRUT,DIQ,ABMP("DDL"),ABMP("CHK"),ABMP("ERROR LIST")

 Q

 ;

EOP I $G(ABMC("QUE"))'=2 W $$EN^ABMVDF("IOF")

 Q

ABMDECK   ; IHS/ASDST/DMJ - Check Claim Data for Errors ; 

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

 +2       ;

 +3       ;IHS/SD/EFG - V2.5 P8 - IM16385

 +4       ;   Modified to display page 8H for visit type 998

 +5       ;

 +6        KILL ABMC

SEL        KILL DIR

           SET DIR(0)="S^1:DETAILED CLAIM LISTING;2:ERROR LISTING ONLY"_$SELECT($ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0)):";3:PCC VISIT DISPLAY;4:HEALTH SUMMARY",$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,0)):";3:APC VISIT DISPLAY",1:"")

 +1        SET DIR("A")="Enter DESIRED REPORT"

           SET DIR("B")=2

           DO ^DIR

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

               GOTO XIT

 +3        IF Y=1

               SET ABMP("DDL")=""

               GOTO START

 +4        IF Y=2

               SET ABMP("ERROR LIST")=""

               GOTO START

 +5        IF Y=3

               IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0))

                   Begin DoDot:1

 +6                    SET ABMC=0

                       FOR 

                           SET ABMC=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMC))

                           IF 'ABMC

                               QUIT 

                           SET ABMDVDSP=ABMC

                           DO ^ABMDVDSP

                   End DoDot:1

                   GOTO XIT

 +7        IF Y=3

               IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,0))

                   Begin DoDot:1

 +8                    SET ABMC=0

                       FOR 

                           SET ABMC=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,ABMC))

                           IF 'ABMC

                               QUIT 

                           SET ABMDADSP=ABMC

                           DO ^ABMDADSP

                   End DoDot:1

                   GOTO XIT

 +9        IF Y=4

               SET APCHSTYP=$ORDER(^APCHSCTL("B","ADULT REGULAR",0))

               SET APCHSPAT=ABMP("PDFN")

               IF APCHSTYP

                   DO EN^APCHS

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL APCHSTYP,APCHSPAT

                   GOTO XIT

 +10       WRITE *7

           GOTO SEL

START      SET ABMP("PG")=0

           SET ABMP("HEAD2")="CLAIM DATA ERRORS"

ZIS        WRITE !!

           SET %ZIS("A")="Output DEVICE: "

           SET %ZIS="NQ"

           DO ^%ZIS

 +1        IF IO'=IO(0)

               Begin DoDot:1

 +2                SET ZTRTN="ENT^ABMDECK"

                   SET ZTDESC="3P BILLING CLAIM DATA-CHECK/DISPLAY"

 +3                SET ZTSAVE("ABMP(")=""

 +4                DO ^%ZTLOAD

 +5                IF $GET(ZTSK)

                       WRITE "(Job Queued, Task Number: ",ZTSK,")"

 +6                DO HOME^%ZIS

 +7                KILL ABMP("DDL"),ABMP("ERROR LIST")

               End DoDot:1

               QUIT 

 +8        IF $DATA(IO("S"))

               SET IOP=ION

               DO ^%ZIS

 +9        GOTO BEGIN

 +10      ;

ENT       ;EP - TaskMan Entry Point

 +1        SET ABMC("QUEON")=""

BEGIN      SET ABMC("CTR")=0

 +1        SET ABMC("ERR")=0

 +2        IF '$DATA(ABMP("DDL"))

               GOTO ERRIN

 +3        SET ABMD("CTR")=0

           SET ABMC("DDL")=""

           SET ABMP("SCRN")=1

           SET ABMP("RTN")="^ABMDE1"

 +4        DO ^ABMDEVAR

           DO SCRN^ABMDE

 +5        KILL ABMP("QUIT"),DIROUT,DTOUT,DUOUT,DIR

           GOTO DONE

 +6       ;

ERRIN     ;EP - for Claim Error Listing

 +1        SET (ABMC("CTR"),ABMC("ERR"),ABMP("CHK"))=0

 +2        SET ABMZ("PG")="E"

           SET ABMZ("TITL")="ERROR LISTING"

           IF '$DATA(ABMC("QUE"))

               IF '$GET(ABMQUIET)

                   DO SUM^ABMDE1

 +3       ;

 +4        SET (ABMC("I"),ABMC("J"))=1

           SET ABMC("K")="ERR"

LOOP      ;LOOP

 +1        IF '$GET(ABMQUIET)

               Begin DoDot:1

 +2                IF '($Y>(IOSL-5))

                       QUIT 

 +3                SET ABMC("DO")=$SELECT('$DATA(ABMC("QUE")):"EOP^ABMDERR",1:"EOP")

                   DO @ABMC("DO")

               End DoDot:1

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

               GOTO DONE

 +5        KILL ABME

 +6        SET ABMC=$PIECE(ABMP("PAGE"),",",ABMC("I"))

           IF ABMC=""

               GOTO DONE

           IF $DATA(ABMC("E0"))

               IF ABMC("CTR")>0

                   GOTO DONE

 +7        IF ABMC=0

               Begin DoDot:1

 +8                SET ABMC("I")=ABMC("I")+1

 +9                DO ^ABMDE0X

 +10               IF +$ORDER(ABME(0))

                       SET ABME("CHK")=""

                       SET ABMC("DO")=$SELECT($DATA(ABMC("QUE")):"QUE^ABMDERR",$GET(ABMQUIET):"QUE^ABMDERR",1:"^ABMDERR")

                       DO @ABMC("DO")

               End DoDot:1

               GOTO LOOP

 +11       IF ABMC=5

               SET ABMC("K")=$PIECE("A,B",",",ABMC("J"))

 +12       IF ABMC=8

               SET ABMC("K")=$PIECE("A,B,C,D,E,F,G,H",",",ABMC("J"))

               IF ABMP("BTYP")=831&$DATA(ABMP("FLAT"))&(ABMC("K")'="B")

                   GOTO INCR

               IF ABMP("VTYP")=998&("DEFH"'[ABMC("K"))

                   GOTO INCR

 +13       IF ABMC=9

               SET ABMC("K")=$PIECE("A,B,C,D,E,F",",",ABMC("J"))

 +14       DO @(ABMC("K")_"^ABMDE"_ABMC_"X")

INCR       IF ABMC=5

               SET ABMC("J")=$SELECT(ABMC("K")="B":1,1:ABMC("J")+1)

               SET ABMC("I")=$SELECT(ABMC("K")="B":ABMC("I")+1,1:ABMC("I"))

               IF ABMC("J")=1

                   SET ABMC("K")="ERR"

               GOTO CHK

 +1        IF ABMC=8

               SET ABMC("I")=$SELECT(ABMC("K")="H":ABMC("I")+1,1:ABMC("I"))

               SET ABMC("J")=$SELECT(ABMC("K")="H":1,1:ABMC("J")+1)

               GOTO CHK

 +2        IF ABMC=9

               SET ABMC("I")=$SELECT(ABMC("K")="F":0,1:ABMC("I"))

               SET ABMC("J")=$SELECT(ABMC("I")=0:0,1:ABMC("J")+1)

               GOTO CHK

 +3        SET ABMC("I")=ABMC("I")+1

CHK        IF +$ORDER(ABME(0))

               SET ABME("CHK")=""

               SET ABMC("DO")=$SELECT($DATA(ABMC("QUE")):"QUE^ABMDERR",$GET(ABMQUIET):"QUE^ABMDERR",1:"^ABMDERR")

               DO @ABMC("DO")

 +1        IF ABMC=0

               GOTO DONE

 +2        GOTO LOOP

DONE      ;DONE WITH LOOP

 +1        SET DIE="^ABMDCLM(DUZ(2),"

           SET DA=ABMP("CDFN")

 +2        SET DR=".05////"_ABMC("CTR")

           DO ^DIE

 +3        IF $GET(ABMQUIET)

               GOTO XIT

 +4        IF $DATA(ABMP("DDL"))!($DATA(ABMP("ERROR LIST")))

               WRITE !!,"(End of Report)"

 +5        IF IO'=IO(0)!($EXTRACT(IOST)'="C")!($DATA(IO("S")))

               WRITE $$EN^ABMVDF("IOF")

               DO ^%ZISC

               IF 1

 +6       IF '$TEST

               IF $DATA(ABMP("DDL"))!$DATA(ABMP("ERROR LIST"))

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

 +7        IF $DATA(ABMC("E0"))

               QUIT 

 +8        IF $DATA(ABMC("QUEON"))

               GOTO XIT

 +9        IF $DATA(ABMP("DDL"))

               GOTO XIT

 +10      ;

ERR        IF ABMC("CTR")>0

               WRITE !!,*7,"  =========================================================================== "

 +1       IF $TEST

               WRITE !,"    Fatal ERRORS Exist a Bill can not be Generated until they are Resolved!    "

 +2       IF $TEST

               WRITE !,"  =========================================================================== ",!

               DO HLP^ABMDERR

 +3       ;

 +4       ;

XIT        KILL ABM,ABMC,POP,ZTSK,DIRUT,DTOUT,IO("Q"),DIR,DIRUT,DIQ,ABMP("DDL"),ABMP("CHK"),ABMP("ERROR LIST")

 +1        QUIT 

 +2       ;

EOP        IF $GET(ABMC("QUE"))'=2

               WRITE $$EN^ABMVDF("IOF")

 +1        QUIT