ABMDEDIK.m

ABMDEDIK ; IHS/ASDST/DMJ - DELETE Claims ;

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

 ;

 S ABM("X")=""

 S ABM="" F  S ABM=$O(^DD(9002274.3,0,"IX",ABM)) Q:ABM=""  D

 .S ABM("X")=ABM("X")_ABM_","

 .Q

 I ABM("X")="AD,AINP,APC,AS,AV,B," G KILL

 I ABM("X")="AD,APC,AS,AV,B," G KILL

 S DIK="^ABMDCLM(DUZ(2)," D ^DIK

 Q

 ;

KILL Q:'$D(^ABMDCLM(DUZ(2),DA,0))  S ABM(0)=^(0),$P(^ABMDCLM(DUZ(2),0),U,4)=$P(ABM(0),U,4)-1

 K ^ABMDCLM(DUZ(2),"B",+ABM(0),DA)

 K ^ABMDCLM(DUZ(2),"AD",$P(ABM(0),U,2),DA)

 K ^ABMDCLM(DUZ(2),"AS",$P(ABM(0),U,4),DA)

 I $P($G(^ABMDCLM(DUZ(2),DA,5)),U,9)]"" K ^ABMDCLM(DUZ(2),"AINP",$P(^(5),U,9),DA)

 S ABM=0 F  S ABM=$O(^ABMDCLM(DUZ(2),DA,11,ABM)) Q:'ABM  D

 .S ABM(0)=$G(^ABMDCLM(DUZ(2),DA,11,ABM,0)) Q:'ABM(0)

 .K ^ABMDCLM(DUZ(2),"AV",+ABM(0),DA,ABM)

 S ABM=0 F  S ABM=$O(^ABMDCLM(DUZ(2),DA,15,ABM)) Q:'ABM  D

 .S ABM(0)=$G(^ABMDCLM(DUZ(2),DA,15,ABM,0)) Q:'ABM(0)

 .K ^ABMDCLM(DUZ(2),"APC",+ABM(0),DA,ABM)

 K ^ABMDCLM(DUZ(2),DA)

 Q

ABMDEDIK  ; IHS/ASDST/DMJ - DELETE Claims ;

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

 +2       ;

 +3        SET ABM("X")=""

 +4        SET ABM=""

           FOR 

               SET ABM=$ORDER(^DD(9002274.3,0,"IX",ABM))

               IF ABM=""

                   QUIT 

               Begin DoDot:1

 +5                SET ABM("X")=ABM("X")_ABM_","

 +6                QUIT 

               End DoDot:1

 +7        IF ABM("X")="AD,AINP,APC,AS,AV,B,"

               GOTO KILL

 +8        IF ABM("X")="AD,APC,AS,AV,B,"

               GOTO KILL

 +9        SET DIK="^ABMDCLM(DUZ(2),"

           DO ^DIK

 +10       QUIT 

 +11      ;

KILL       IF '$DATA(^ABMDCLM(DUZ(2),DA,0))

               QUIT 

           SET ABM(0)=^(0)

           SET $PIECE(^ABMDCLM(DUZ(2),0),U,4)=$PIECE(ABM(0),U,4)-1

 +1        KILL ^ABMDCLM(DUZ(2),"B",+ABM(0),DA)

 +2        KILL ^ABMDCLM(DUZ(2),"AD",$PIECE(ABM(0),U,2),DA)

 +3        KILL ^ABMDCLM(DUZ(2),"AS",$PIECE(ABM(0),U,4),DA)

 +4        IF $PIECE($GET(^ABMDCLM(DUZ(2),DA,5)),U,9)]""

               KILL ^ABMDCLM(DUZ(2),"AINP",$PIECE(^(5),U,9),DA)

 +5        SET ABM=0

           FOR 

               SET ABM=$ORDER(^ABMDCLM(DUZ(2),DA,11,ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +6                SET ABM(0)=$GET(^ABMDCLM(DUZ(2),DA,11,ABM,0))

                   IF 'ABM(0)

                       QUIT 

 +7                KILL ^ABMDCLM(DUZ(2),"AV",+ABM(0),DA,ABM)

               End DoDot:1

 +8        SET ABM=0

           FOR 

               SET ABM=$ORDER(^ABMDCLM(DUZ(2),DA,15,ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +9                SET ABM(0)=$GET(^ABMDCLM(DUZ(2),DA,15,ABM,0))

                   IF 'ABM(0)

                       QUIT 

 +10               KILL ^ABMDCLM(DUZ(2),"APC",+ABM(0),DA,ABM)

               End DoDot:1

 +11       KILL ^ABMDCLM(DUZ(2),DA)

 +12       QUIT