- 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
