ABMDE6X.m

ABMDE6X ; IHS/ASDST/DMJ - Page 6 - ERROR CHECKS ;

 ;;2.6;IHS 3P BILLING SYSTEM;**8,14**;NOV 12, 2009;Build 238

 ;

 ; Added code for new error 217

 ;

 ;IHS/SD/SDR - v2.5 p10 - IM20435 - Removed error from claim editor; AIDC said these should be caught during PCC data

 ;   entry and error is no longer needed

 ;IHS/SD/SDR - 2.6*14 HEAT163747 - Updated error 217 so it only displays one for ea service line, no matter how many coor dx are present

 ;

ERR S ABME("TITL")="PAGE 6 - DENTAL INFORMATION"

A S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABMX)) Q:'ABMX  D A1

 I ABMX("I")=1 S ABME(137)=""

 G XIT

A1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABMX,0)

 I $P(ABMX("X0"),U,7)="" S DA(1)=ABMP("CDFN"),DIK="^ABMDCLM(DUZ(2),"_DA(1)_",33,",DA=ABMX D ^DIK Q

 I $P(ABMX("X0"),U,2)=""&($P(^ABMDEXP(ABMP("EXP"),0),U)["UB") S ABME(121)=""

 S ABMCODXS=$P(ABMX("X0"),U,4)

 I ABMCODXS'="" D

 .F ABMJ=1:1 S ABMCODX=$P(ABMCODXS,",",ABMJ) Q:+$G(ABMCODX)=0  D

 ..;start old code abm*2.6*8 NOHEAT

 ..;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX

 ..;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX

 ..;end old code start new code

 ..;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I")  ;abm*2.6*14 HEAT163747

 ..I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") Q:ABME(217)[(ABMX("I"))  S ABME(217)=$G(ABME(217))_","_ABMX("I")  ;abm*2.6*14 HEAT163747

 ..I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX("I")

 ..;end new code

 I $P(ABMX("X0"),U,7)]"",$P(ABMX("X0"),U,7)<ABMP("VDT") S ABME(127)=""

 I $P(^AUTTADA(+ABMX("X0"),0),U,9)]"" Q

 I $P(ABMX("X0"),U,5)="",$P(ABMX("X0"),U,11)="" S ABME(133)=""

 Q

 ;

XIT K ABMX

 Q

ABMDE6X   ; IHS/ASDST/DMJ - Page 6 - ERROR CHECKS ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**8,14**;NOV 12, 2009;Build 238

 +2       ;

 +3       ; Added code for new error 217

 +4       ;

 +5       ;IHS/SD/SDR - v2.5 p10 - IM20435 - Removed error from claim editor; AIDC said these should be caught during PCC data

 +6       ;   entry and error is no longer needed

 +7       ;IHS/SD/SDR - 2.6*14 HEAT163747 - Updated error 217 so it only displays one for ea service line, no matter how many coor dx are present

 +8       ;

ERR        SET ABME("TITL")="PAGE 6 - DENTAL INFORMATION"

A          SET ABMX=0

           FOR ABMX("I")=1:1

               SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABMX))

               IF 'ABMX

                   QUIT 

               DO A1

 +1        IF ABMX("I")=1

               SET ABME(137)=""

 +2        GOTO XIT

A1         SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABMX,0)

 +1        IF $PIECE(ABMX("X0"),U,7)=""

               SET DA(1)=ABMP("CDFN")

               SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",33,"

               SET DA=ABMX

               DO ^DIK

               QUIT 

 +2        IF $PIECE(ABMX("X0"),U,2)=""&($PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB")

               SET ABME(121)=""

 +3        SET ABMCODXS=$PIECE(ABMX("X0"),U,4)

 +4        IF ABMCODXS'=""

               Begin DoDot:1

 +5                FOR ABMJ=1:1

                       SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)

                       IF +$GET(ABMCODX)=0

                           QUIT 

                       Begin DoDot:2

 +6       ;start old code abm*2.6*8 NOHEAT

 +7       ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX

 +8       ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX

 +9       ;end old code start new code

 +10      ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I")  ;abm*2.6*14 HEAT163747

 +11      ;abm*2.6*14 HEAT163747

                           IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0

                               IF ($GET(ABME(217))'="")

                                   IF ABME(217)[(ABMX("I"))

                                       QUIT 

                                   SET ABME(217)=$GET(ABME(217))_","_ABMX("I")

 +12                       IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0

                               IF ($GET(ABME(217))="")

                                   SET ABME(217)=ABMX("I")

 +13      ;end new code

                       End DoDot:2

               End DoDot:1

 +14       IF $PIECE(ABMX("X0"),U,7)]""

               IF $PIECE(ABMX("X0"),U,7)<ABMP("VDT")

                   SET ABME(127)=""

 +15       IF $PIECE(^AUTTADA(+ABMX("X0"),0),U,9)]""

               QUIT 

 +16       IF $PIECE(ABMX("X0"),U,5)=""

               IF $PIECE(ABMX("X0"),U,11)=""

                   SET ABME(133)=""

 +17       QUIT 

 +18      ;

XIT        KILL ABMX

 +1        QUIT