ABMDBXRF.m

ABMDBXRF ; IHS/DSD/DMJ - x-ref all indexs in Bill file ;

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

 ;

 Q:'$G(DA)  Q:'$D(^ABMDBILL(DA))

 S ABM("X")=""

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

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

 .Q

 I ABM("X")="AA,AC,AD,AE,AJ,AP,APC,AS,AV,AX,AZ,B,D," G XREF

 S DIK="^ABMDBILL(" D IX1^DIK

 Q

 ;

XREF S ABM(0)=^ABMDBILL(DA,0),ABM(1)=$G(^(1)),ABM(2)=$G(^(2)),ABM(7)=$G(^(7))

 S:$P(ABM(1),U,6)]"" ^ABMDBILL("AA",$P(ABM(1),U,6),DA)=""

 S ^ABMDBILL("AC",$P(ABM(0),U,4),DA)=""

 S:$P(ABM(7),U,1)]"" ^ABMDBILL("AD",$P(ABM(7),U,1),DA)=""

 S ^ABMDBILL("AJ",$P(ABM(0),U,8),DA)=""

 S:$P(ABM(1),U,5)]"" ^ABMDBILL("AP",$P(ABM(1),U,5),DA)=""

 S ^ABMDBILL("AS",+$P(ABM(0),U),$P(ABM(0),U,4),DA)=""

 S:$P(ABM(1),U,7)]"" ^ABMDBILL("AX",$P(ABM(1),U,7),DA)=""

 S:$P(ABM(1),U,8)]"" ^ABMDBILL("AZ",$P(ABM(1),U,8),DA)=""

 S ^ABMDBILL("B",$P(ABM(0),U),DA)=""

 S ^ABMDBILL("D",$P(ABM(0),U,5),DA)=""

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

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

 .S ^ABMDBILL("AV",+ABM(0),DA,ABM)=""

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

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

 .S ^ABMDBILL("APC",+ABM(0),DA,ABM)=""

 S ABM=0 F  S ABM=$O(^ABMDBILL(DA,3,ABM)) Q:'ABM  D

 .S ABM(0)=$G(^ABMDBILL(DA,3,ABM,0)) Q:'ABM(0)

 .S ^ABMDBILL("AE",+ABM(0),DA,ABM)=""

 Q

ABMDBXRF  ; IHS/DSD/DMJ - x-ref all indexs in Bill file ;

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

 +2       ;

 +3        IF '$GET(DA)

               QUIT 

           IF '$DATA(^ABMDBILL(DA))

               QUIT 

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

 +5        SET ABM=""

           FOR 

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

               IF ABM=""

                   QUIT 

               Begin DoDot:1

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

 +7                QUIT 

               End DoDot:1

 +8        IF ABM("X")="AA,AC,AD,AE,AJ,AP,APC,AS,AV,AX,AZ,B,D,"

               GOTO XREF

 +9        SET DIK="^ABMDBILL("

           DO IX1^DIK

 +10       QUIT 

 +11      ;

XREF       SET ABM(0)=^ABMDBILL(DA,0)

           SET ABM(1)=$GET(^(1))

           SET ABM(2)=$GET(^(2))

           SET ABM(7)=$GET(^(7))

 +1        IF $PIECE(ABM(1),U,6)]""

               SET ^ABMDBILL("AA",$PIECE(ABM(1),U,6),DA)=""

 +2        SET ^ABMDBILL("AC",$PIECE(ABM(0),U,4),DA)=""

 +3        IF $PIECE(ABM(7),U,1)]""

               SET ^ABMDBILL("AD",$PIECE(ABM(7),U,1),DA)=""

 +4        SET ^ABMDBILL("AJ",$PIECE(ABM(0),U,8),DA)=""

 +5        IF $PIECE(ABM(1),U,5)]""

               SET ^ABMDBILL("AP",$PIECE(ABM(1),U,5),DA)=""

 +6        SET ^ABMDBILL("AS",+$PIECE(ABM(0),U),$PIECE(ABM(0),U,4),DA)=""

 +7        IF $PIECE(ABM(1),U,7)]""

               SET ^ABMDBILL("AX",$PIECE(ABM(1),U,7),DA)=""

 +8        IF $PIECE(ABM(1),U,8)]""

               SET ^ABMDBILL("AZ",$PIECE(ABM(1),U,8),DA)=""

 +9        SET ^ABMDBILL("B",$PIECE(ABM(0),U),DA)=""

 +10       SET ^ABMDBILL("D",$PIECE(ABM(0),U,5),DA)=""

 +11       SET ABM=0

           FOR 

               SET ABM=$ORDER(^ABMDBILL(DA,11,ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +12               SET ABM(0)=$GET(^ABMDBILL(DA,11,ABM,0))

                   IF 'ABM(0)

                       QUIT 

 +13               SET ^ABMDBILL("AV",+ABM(0),DA,ABM)=""

               End DoDot:1

 +14       SET ABM=0

           FOR 

               SET ABM=$ORDER(^ABMDBILL(DA,15,ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +15               SET ABM(0)=$GET(^ABMDBILL(DA,15,ABM,0))

                   IF 'ABM(0)

                       QUIT 

 +16               SET ^ABMDBILL("APC",+ABM(0),DA,ABM)=""

               End DoDot:1

 +17       SET ABM=0

           FOR 

               SET ABM=$ORDER(^ABMDBILL(DA,3,ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +18               SET ABM(0)=$GET(^ABMDBILL(DA,3,ABM,0))

                   IF 'ABM(0)

                       QUIT 

 +19               SET ^ABMDBILL("AE",+ABM(0),DA,ABM)=""

               End DoDot:1

 +20       QUIT