BGP0ASL1 ; IHS/CMI/LAB - DISPLAY IND LISTS 28 Apr 2006 2:10 PM ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;; ;
NGR ;EP
K BGPTIND S BGPHIGH=""
S BGPSUCNT=0,BGPSU="",BGPSUC=0
S BGPX=0 F S BGPX=$O(^BGPGPDCT(BGPX)) Q:BGPX'=+BGPX S V=$G(^BGPGPDCT(BGPX,0)) D
.Q:'$D(^BGPGPDCT(BGPX,0))
.Q:$P(V,U)'=BGPBD
.Q:$P(V,U,2)'=BGPED
.Q:$P(V,U,7)'=BGPPER
.I $G(BGP0GPU),$P(V,U,12)'=9 Q
.I '$G(BGP0GPU),$P(V,U,12)'=1 Q
.I $G(BGPCHWE) Q:'$O(^BGPGPDCT(BGPX,88888,0))
.Q:$P(V,U,5)'=BGPBBD
.Q:$P(V,U,6)'=BGPBED
.Q:$P(V,U,14)'=BGPBEN
.S BGPSUC=BGPSUC+1,BGPTIND(BGPSUC,0)=BGPSUC_")"
.S Y=""
.S $E(Y,4)=$E($$SU($P(V,U,11)),1,10)
.S $E(Y,15)=$E($$FAC($P(V,U,9)),1,13)_$S($P(^BGPGPDCT(BGPX,0),U,17):"+",1:"")
.S $E(Y,30)=$$DATE^BGP0UTL($P(V,U))
.S $E(Y,40)=$$DATE^BGP0UTL($P(V,U,2))
.S $E(Y,50)=$$DATE^BGP0UTL($P(V,U,5))
.S $E(Y,60)=$$DATE^BGP0UTL($P(V,U,6))
.S $E(Y,70)=$$DATE^BGP0UTL($P(V,U,13))
.S BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
.S BGPTIND(BGPSUC,BGPSUC)=BGPX
.I $D(BGPSUL(BGPX)) S BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
.Q
S (VALMCNT,BGPHIGH)=BGPSUC
Q
;
ONM ;EP
K BGPTIND S BGPHIGH=""
S BGPSUCNT=0,BGPSU="",BGPSUC=0
S BGPX=0 F S BGPX=$O(^BGPGPDCT(BGPX)) Q:BGPX'=+BGPX S V=$G(^BGPGPDCT(BGPX,0)) D
.Q:'$D(^BGPGPDCT(BGPX,0))
.Q:$P(V,U)'=BGPBD
.Q:$P(V,U,2)'=BGPED
.Q:$P(V,U,7)'=BGPPER
.Q:$P(V,U,5)'=BGPBBD
.Q:$P(V,U,6)'=BGPBED
.Q:$P(V,U,14)'=BGPBEN
.Q:$P(V,U,12)'=7
.S BGPSUC=BGPSUC+1,BGPTIND(BGPSUC,0)=BGPSUC_")"
.S Y=""
.S $E(Y,4)=$E($$SU($P(V,U,11)),1,10)
.S $E(Y,15)=$E($$FAC($P(V,U,9)),1,13)_$S($P(^BGPGPDCT(BGPX,0),U,17):"+",1:"")
.S $E(Y,30)=$$DATE^BGP0UTL($P(V,U))
.S $E(Y,40)=$$DATE^BGP0UTL($P(V,U,2))
.S $E(Y,50)=$$DATE^BGP0UTL($P(V,U,5))
.S $E(Y,60)=$$DATE^BGP0UTL($P(V,U,6))
.S $E(Y,70)=$$DATE^BGP0UTL($P(V,U,13))
.S BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
.S BGPTIND(BGPSUC,BGPSUC)=BGPX
.I $D(BGPSUL(BGPX)) S BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
.Q
S (VALMCNT,BGPHIGH)=BGPSUC
Q
;
ELD ;EP
K BGPTIND S BGPHIGH=""
S BGPSUCNT=0,BGPSU="",BGPSUC=0
S BGPX=0 F S BGPX=$O(^BGPELDCT(BGPX)) Q:BGPX'=+BGPX I BGPX S V=$G(^BGPELDCT(BGPX,0)) D
.Q:'$D(^BGPELDCT(BGPX,0))
.Q:$P(V,U)'=BGPBD
.Q:$P(V,U,2)'=BGPED
.Q:$P(V,U,7)'=BGPPER
.Q:$P(V,U,12)'=5
.Q:$P(V,U,5)'=BGPBBD
.Q:$P(V,U,6)'=BGPBED
.Q:$P(V,U,14)'=BGPBEN
.S BGPSUC=BGPSUC+1,BGPTIND(BGPSUC,0)=BGPSUC_")"
.S Y=""
.S $E(Y,4)=$E($$SU($P(V,U,11)),1,10)
.S $E(Y,15)=$E($$FAC($P(V,U,9)),1,13)_$S($P(^BGPELDCT(BGPX,0),U,17):"+",1:"")
.S $E(Y,30)=$$DATE^BGP0UTL($P(V,U))
.S $E(Y,40)=$$DATE^BGP0UTL($P(V,U,2))
.S $E(Y,50)=$$DATE^BGP0UTL($P(V,U,5))
.S $E(Y,60)=$$DATE^BGP0UTL($P(V,U,6))
.S $E(Y,70)=$$DATE^BGP0UTL($P(V,U,13))
.S BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
.S BGPTIND(BGPSUC,BGPSUC)=BGPX
.I $D(BGPSUL(BGPX)) S BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
.Q
S (VALMCNT,BGPHIGH)=BGPSUC
Q
;
HED ;EP
K BGPTIND S BGPHIGH=""
S BGPSUCNT=0,BGPSU="",BGPSUC=0
S BGPX=0 F S BGPX=$O(^BGPHEDCT(BGPX)) Q:'BGPX I BGPX S V=$G(^BGPHEDCT(BGPX,0)) D
.Q:'$D(^BGPHEDCT(BGPX,0))
.Q:$P(V,U)'=BGPBD
.Q:$P(V,U,2)'=BGPED
.Q:$P(V,U,7)'=BGPPER
.Q:$P(V,U,12)'=3
.Q:$P(V,U,5)'=BGPBBD
.Q:$P(V,U,6)'=BGPBED
.Q:$P(V,U,14)'=BGPBEN
.S BGPSUC=BGPSUC+1,BGPTIND(BGPSUC,0)=BGPSUC_")"
.S Y=""
.S $E(Y,4)=$E($$SU($P(V,U,11)),1,10)
.S $E(Y,15)=$E($$FAC($P(V,U,9)),1,13)_$S($P(^BGPHEDCT(BGPX,0),U,17):"+",1:"")
.S $E(Y,30)=$$DATE^BGP0UTL($P(V,U))
.S $E(Y,40)=$$DATE^BGP0UTL($P(V,U,2))
.S $E(Y,50)=$$DATE^BGP0UTL($P(V,U,5))
.S $E(Y,60)=$$DATE^BGP0UTL($P(V,U,6))
.S $E(Y,70)=$$DATE^BGP0UTL($P(V,U,13))
.S BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
.S BGPTIND(BGPSUC,BGPSUC)=BGPX
.I $D(BGPSUL(BGPX)) S BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
.Q
S (VALMCNT,BGPHIGH)=BGPSUC
Q
PED ;EP
K BGPTIND S BGPHIGH=""
S BGPSUCNT=0,BGPSU="",BGPSUC=0
S BGPX=0 F S BGPX=$O(^BGPPEDCT(BGPX)) Q:BGPX'=+BGPX I BGPX S V=$G(^BGPPEDCT(BGPX,0)) D
.Q:'$D(^BGPPEDCT(BGPX,0))
.Q:$P(V,U)'=BGPBD
.Q:$P(V,U,2)'=BGPED
.Q:$P(V,U,7)'=BGPPER
.Q:$P(V,U,5)'=BGPBBD
.Q:$P(V,U,6)'=BGPBED
.Q:$P(V,U,11)'=BGPBEN
.S BGPSUC=BGPSUC+1,BGPTIND(BGPSUC,0)=BGPSUC_")"
.S Y=""
.S $E(Y,4)=$E($$SU($P(V,U,10)),1,10)
.S $E(Y,15)=$E($$FAC($P(V,U,9)),1,13)_$S($P(^BGPPEDCT(BGPX,0),U,17):"+",1:"")
.S $E(Y,30)=$$DATE^BGP0UTL($P(V,U))
.S $E(Y,40)=$$DATE^BGP0UTL($P(V,U,2))
.S $E(Y,50)=$$DATE^BGP0UTL($P(V,U,5))
.S $E(Y,60)=$$DATE^BGP0UTL($P(V,U,6))
.S $E(Y,70)=$$DATE^BGP0UTL($P(V,U,13))
.S BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
.S BGPTIND(BGPSUC,BGPSUC)=BGPX
.I $D(BGPSUL(BGPX)) S BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
.Q
S (VALMCNT,BGPHIGH)=BGPSUC
Q
FAC(S) ;
NEW N S N=$O(^AUTTLOC("C",S,0))
I N="" Q N
Q $P(^DIC(4,N,0),U)
SU(S) ;
NEW N S N=$O(^AUTTSU("C",S,0))
I N="" Q N
Q $P(^AUTTSU(N,0),U)
EO ;EP
K BGPTIND S BGPHIGH=""
S BGPSUCNT=0,BGPSU="",BGPSUC=0
S BGPX=0 F S BGPX=$O(^BGPEOCT(BGPX)) Q:BGPX'=+BGPX I BGPX S V=$G(^BGPEOCT(BGPX,0)) D
.Q:'$D(^BGPEOCT(BGPX,0))
.Q:$P(V,U)'=BGPBD
.Q:$P(V,U,2)'=BGPED
.Q:$P(V,U,7)'=BGPPER
.Q:$P(V,U,12)'=8
.Q:$P(V,U,5)'=BGPBBD
.Q:$P(V,U,6)'=BGPBED
.Q:$P(V,U,14)'=BGPBEN
.S BGPSUC=BGPSUC+1,BGPTIND(BGPSUC,0)=BGPSUC_")"
.S Y=""
.S $E(Y,4)=$E($$SU($P(V,U,11)),1,10)
.S $E(Y,15)=$E($$FAC($P(V,U,9)),1,13)_$S($P(^BGPEOCT(BGPX,0),U,17):"+",1:"")
.S $E(Y,30)=$$DATE^BGP0UTL($P(V,U))
.S $E(Y,40)=$$DATE^BGP0UTL($P(V,U,2))
.S $E(Y,50)=$$DATE^BGP0UTL($P(V,U,5))
.S $E(Y,60)=$$DATE^BGP0UTL($P(V,U,6))
.S $E(Y,70)=$$DATE^BGP0UTL($P(V,U,13))
.S BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
.S BGPTIND(BGPSUC,BGPSUC)=BGPX
.I $D(BGPSUL(BGPX)) S BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
.Q
S (VALMCNT,BGPHIGH)=BGPSUC
Q
;
BGP0ASL1 ; IHS/CMI/LAB - DISPLAY IND LISTS 28 Apr 2006 2:10 PM ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;; ;
NGR ;EP
+1 KILL BGPTIND
SET BGPHIGH=""
+2 SET BGPSUCNT=0
SET BGPSU=""
SET BGPSUC=0
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPGPDCT(BGPX))
IF BGPX'=+BGPX
QUIT
SET V=$GET(^BGPGPDCT(BGPX,0))
Begin DoDot:1
+4 IF '$DATA(^BGPGPDCT(BGPX,0))
QUIT
+5 IF $PIECE(V,U)'=BGPBD
QUIT
+6 IF $PIECE(V,U,2)'=BGPED
QUIT
+7 IF $PIECE(V,U,7)'=BGPPER
QUIT
+8 IF $GET(BGP0GPU)
IF $PIECE(V,U,12)'=9
QUIT
+9 IF '$GET(BGP0GPU)
IF $PIECE(V,U,12)'=1
QUIT
+10 IF $GET(BGPCHWE)
IF '$ORDER(^BGPGPDCT(BGPX,88888,0))
QUIT
+11 IF $PIECE(V,U,5)'=BGPBBD
QUIT
+12 IF $PIECE(V,U,6)'=BGPBED
QUIT
+13 IF $PIECE(V,U,14)'=BGPBEN
QUIT
+14 SET BGPSUC=BGPSUC+1
SET BGPTIND(BGPSUC,0)=BGPSUC_")"
+15 SET Y=""
+16 SET $EXTRACT(Y,4)=$EXTRACT($$SU($PIECE(V,U,11)),1,10)
+17 SET $EXTRACT(Y,15)=$EXTRACT($$FAC($PIECE(V,U,9)),1,13)_$SELECT($PIECE(^BGPGPDCT(BGPX,0),U,17):"+",1:"")
+18 SET $EXTRACT(Y,30)=$$DATE^BGP0UTL($PIECE(V,U))
+19 SET $EXTRACT(Y,40)=$$DATE^BGP0UTL($PIECE(V,U,2))
+20 SET $EXTRACT(Y,50)=$$DATE^BGP0UTL($PIECE(V,U,5))
+21 SET $EXTRACT(Y,60)=$$DATE^BGP0UTL($PIECE(V,U,6))
+22 SET $EXTRACT(Y,70)=$$DATE^BGP0UTL($PIECE(V,U,13))
+23 SET BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
+24 SET BGPTIND(BGPSUC,BGPSUC)=BGPX
+25 IF $DATA(BGPSUL(BGPX))
SET BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
+26 QUIT
End DoDot:1
+27 SET (VALMCNT,BGPHIGH)=BGPSUC
+28 QUIT
+29 ;
ONM ;EP
+1 KILL BGPTIND
SET BGPHIGH=""
+2 SET BGPSUCNT=0
SET BGPSU=""
SET BGPSUC=0
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPGPDCT(BGPX))
IF BGPX'=+BGPX
QUIT
SET V=$GET(^BGPGPDCT(BGPX,0))
Begin DoDot:1
+4 IF '$DATA(^BGPGPDCT(BGPX,0))
QUIT
+5 IF $PIECE(V,U)'=BGPBD
QUIT
+6 IF $PIECE(V,U,2)'=BGPED
QUIT
+7 IF $PIECE(V,U,7)'=BGPPER
QUIT
+8 IF $PIECE(V,U,5)'=BGPBBD
QUIT
+9 IF $PIECE(V,U,6)'=BGPBED
QUIT
+10 IF $PIECE(V,U,14)'=BGPBEN
QUIT
+11 IF $PIECE(V,U,12)'=7
QUIT
+12 SET BGPSUC=BGPSUC+1
SET BGPTIND(BGPSUC,0)=BGPSUC_")"
+13 SET Y=""
+14 SET $EXTRACT(Y,4)=$EXTRACT($$SU($PIECE(V,U,11)),1,10)
+15 SET $EXTRACT(Y,15)=$EXTRACT($$FAC($PIECE(V,U,9)),1,13)_$SELECT($PIECE(^BGPGPDCT(BGPX,0),U,17):"+",1:"")
+16 SET $EXTRACT(Y,30)=$$DATE^BGP0UTL($PIECE(V,U))
+17 SET $EXTRACT(Y,40)=$$DATE^BGP0UTL($PIECE(V,U,2))
+18 SET $EXTRACT(Y,50)=$$DATE^BGP0UTL($PIECE(V,U,5))
+19 SET $EXTRACT(Y,60)=$$DATE^BGP0UTL($PIECE(V,U,6))
+20 SET $EXTRACT(Y,70)=$$DATE^BGP0UTL($PIECE(V,U,13))
+21 SET BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
+22 SET BGPTIND(BGPSUC,BGPSUC)=BGPX
+23 IF $DATA(BGPSUL(BGPX))
SET BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
+24 QUIT
End DoDot:1
+25 SET (VALMCNT,BGPHIGH)=BGPSUC
+26 QUIT
+27 ;
ELD ;EP
+1 KILL BGPTIND
SET BGPHIGH=""
+2 SET BGPSUCNT=0
SET BGPSU=""
SET BGPSUC=0
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPELDCT(BGPX))
IF BGPX'=+BGPX
QUIT
IF BGPX
SET V=$GET(^BGPELDCT(BGPX,0))
Begin DoDot:1
+4 IF '$DATA(^BGPELDCT(BGPX,0))
QUIT
+5 IF $PIECE(V,U)'=BGPBD
QUIT
+6 IF $PIECE(V,U,2)'=BGPED
QUIT
+7 IF $PIECE(V,U,7)'=BGPPER
QUIT
+8 IF $PIECE(V,U,12)'=5
QUIT
+9 IF $PIECE(V,U,5)'=BGPBBD
QUIT
+10 IF $PIECE(V,U,6)'=BGPBED
QUIT
+11 IF $PIECE(V,U,14)'=BGPBEN
QUIT
+12 SET BGPSUC=BGPSUC+1
SET BGPTIND(BGPSUC,0)=BGPSUC_")"
+13 SET Y=""
+14 SET $EXTRACT(Y,4)=$EXTRACT($$SU($PIECE(V,U,11)),1,10)
+15 SET $EXTRACT(Y,15)=$EXTRACT($$FAC($PIECE(V,U,9)),1,13)_$SELECT($PIECE(^BGPELDCT(BGPX,0),U,17):"+",1:"")
+16 SET $EXTRACT(Y,30)=$$DATE^BGP0UTL($PIECE(V,U))
+17 SET $EXTRACT(Y,40)=$$DATE^BGP0UTL($PIECE(V,U,2))
+18 SET $EXTRACT(Y,50)=$$DATE^BGP0UTL($PIECE(V,U,5))
+19 SET $EXTRACT(Y,60)=$$DATE^BGP0UTL($PIECE(V,U,6))
+20 SET $EXTRACT(Y,70)=$$DATE^BGP0UTL($PIECE(V,U,13))
+21 SET BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
+22 SET BGPTIND(BGPSUC,BGPSUC)=BGPX
+23 IF $DATA(BGPSUL(BGPX))
SET BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
+24 QUIT
End DoDot:1
+25 SET (VALMCNT,BGPHIGH)=BGPSUC
+26 QUIT
+27 ;
HED ;EP
+1 KILL BGPTIND
SET BGPHIGH=""
+2 SET BGPSUCNT=0
SET BGPSU=""
SET BGPSUC=0
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPHEDCT(BGPX))
IF 'BGPX
QUIT
IF BGPX
SET V=$GET(^BGPHEDCT(BGPX,0))
Begin DoDot:1
+4 IF '$DATA(^BGPHEDCT(BGPX,0))
QUIT
+5 IF $PIECE(V,U)'=BGPBD
QUIT
+6 IF $PIECE(V,U,2)'=BGPED
QUIT
+7 IF $PIECE(V,U,7)'=BGPPER
QUIT
+8 IF $PIECE(V,U,12)'=3
QUIT
+9 IF $PIECE(V,U,5)'=BGPBBD
QUIT
+10 IF $PIECE(V,U,6)'=BGPBED
QUIT
+11 IF $PIECE(V,U,14)'=BGPBEN
QUIT
+12 SET BGPSUC=BGPSUC+1
SET BGPTIND(BGPSUC,0)=BGPSUC_")"
+13 SET Y=""
+14 SET $EXTRACT(Y,4)=$EXTRACT($$SU($PIECE(V,U,11)),1,10)
+15 SET $EXTRACT(Y,15)=$EXTRACT($$FAC($PIECE(V,U,9)),1,13)_$SELECT($PIECE(^BGPHEDCT(BGPX,0),U,17):"+",1:"")
+16 SET $EXTRACT(Y,30)=$$DATE^BGP0UTL($PIECE(V,U))
+17 SET $EXTRACT(Y,40)=$$DATE^BGP0UTL($PIECE(V,U,2))
+18 SET $EXTRACT(Y,50)=$$DATE^BGP0UTL($PIECE(V,U,5))
+19 SET $EXTRACT(Y,60)=$$DATE^BGP0UTL($PIECE(V,U,6))
+20 SET $EXTRACT(Y,70)=$$DATE^BGP0UTL($PIECE(V,U,13))
+21 SET BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
+22 SET BGPTIND(BGPSUC,BGPSUC)=BGPX
+23 IF $DATA(BGPSUL(BGPX))
SET BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
+24 QUIT
End DoDot:1
+25 SET (VALMCNT,BGPHIGH)=BGPSUC
+26 QUIT
PED ;EP
+1 KILL BGPTIND
SET BGPHIGH=""
+2 SET BGPSUCNT=0
SET BGPSU=""
SET BGPSUC=0
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPPEDCT(BGPX))
IF BGPX'=+BGPX
QUIT
IF BGPX
SET V=$GET(^BGPPEDCT(BGPX,0))
Begin DoDot:1
+4 IF '$DATA(^BGPPEDCT(BGPX,0))
QUIT
+5 IF $PIECE(V,U)'=BGPBD
QUIT
+6 IF $PIECE(V,U,2)'=BGPED
QUIT
+7 IF $PIECE(V,U,7)'=BGPPER
QUIT
+8 IF $PIECE(V,U,5)'=BGPBBD
QUIT
+9 IF $PIECE(V,U,6)'=BGPBED
QUIT
+10 IF $PIECE(V,U,11)'=BGPBEN
QUIT
+11 SET BGPSUC=BGPSUC+1
SET BGPTIND(BGPSUC,0)=BGPSUC_")"
+12 SET Y=""
+13 SET $EXTRACT(Y,4)=$EXTRACT($$SU($PIECE(V,U,10)),1,10)
+14 SET $EXTRACT(Y,15)=$EXTRACT($$FAC($PIECE(V,U,9)),1,13)_$SELECT($PIECE(^BGPPEDCT(BGPX,0),U,17):"+",1:"")
+15 SET $EXTRACT(Y,30)=$$DATE^BGP0UTL($PIECE(V,U))
+16 SET $EXTRACT(Y,40)=$$DATE^BGP0UTL($PIECE(V,U,2))
+17 SET $EXTRACT(Y,50)=$$DATE^BGP0UTL($PIECE(V,U,5))
+18 SET $EXTRACT(Y,60)=$$DATE^BGP0UTL($PIECE(V,U,6))
+19 SET $EXTRACT(Y,70)=$$DATE^BGP0UTL($PIECE(V,U,13))
+20 SET BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
+21 SET BGPTIND(BGPSUC,BGPSUC)=BGPX
+22 IF $DATA(BGPSUL(BGPX))
SET BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
+23 QUIT
End DoDot:1
+24 SET (VALMCNT,BGPHIGH)=BGPSUC
+25 QUIT
FAC(S) ;
+1 NEW N
SET N=$ORDER(^AUTTLOC("C",S,0))
+2 IF N=""
QUIT N
+3 QUIT $PIECE(^DIC(4,N,0),U)
SU(S) ;
+1 NEW N
SET N=$ORDER(^AUTTSU("C",S,0))
+2 IF N=""
QUIT N
+3 QUIT $PIECE(^AUTTSU(N,0),U)
EO ;EP
+1 KILL BGPTIND
SET BGPHIGH=""
+2 SET BGPSUCNT=0
SET BGPSU=""
SET BGPSUC=0
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPEOCT(BGPX))
IF BGPX'=+BGPX
QUIT
IF BGPX
SET V=$GET(^BGPEOCT(BGPX,0))
Begin DoDot:1
+4 IF '$DATA(^BGPEOCT(BGPX,0))
QUIT
+5 IF $PIECE(V,U)'=BGPBD
QUIT
+6 IF $PIECE(V,U,2)'=BGPED
QUIT
+7 IF $PIECE(V,U,7)'=BGPPER
QUIT
+8 IF $PIECE(V,U,12)'=8
QUIT
+9 IF $PIECE(V,U,5)'=BGPBBD
QUIT
+10 IF $PIECE(V,U,6)'=BGPBED
QUIT
+11 IF $PIECE(V,U,14)'=BGPBEN
QUIT
+12 SET BGPSUC=BGPSUC+1
SET BGPTIND(BGPSUC,0)=BGPSUC_")"
+13 SET Y=""
+14 SET $EXTRACT(Y,4)=$EXTRACT($$SU($PIECE(V,U,11)),1,10)
+15 SET $EXTRACT(Y,15)=$EXTRACT($$FAC($PIECE(V,U,9)),1,13)_$SELECT($PIECE(^BGPEOCT(BGPX,0),U,17):"+",1:"")
+16 SET $EXTRACT(Y,30)=$$DATE^BGP0UTL($PIECE(V,U))
+17 SET $EXTRACT(Y,40)=$$DATE^BGP0UTL($PIECE(V,U,2))
+18 SET $EXTRACT(Y,50)=$$DATE^BGP0UTL($PIECE(V,U,5))
+19 SET $EXTRACT(Y,60)=$$DATE^BGP0UTL($PIECE(V,U,6))
+20 SET $EXTRACT(Y,70)=$$DATE^BGP0UTL($PIECE(V,U,13))
+21 SET BGPTIND(BGPSUC,0)=BGPTIND(BGPSUC,0)_Y
+22 SET BGPTIND(BGPSUC,BGPSUC)=BGPX
+23 IF $DATA(BGPSUL(BGPX))
SET BGPTIND(BGPSUC,0)="*"_BGPTIND(BGPSUC,0)
+24 QUIT
End DoDot:1
+25 SET (VALMCNT,BGPHIGH)=BGPSUC
+26 QUIT
+27 ;
