BGP8DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;
I1 ;EP
I '$G(BGPSUMON) D H1^BGP8DPH
I1A1 ;
I BGPINDG'="E" F BGPPC1="1.1","1.2","1.3" Q:BGPQUIT D PI
I BGPINDG="E" F BGPPC1="1.4" D PI
I BGPINDG'="E" D I1AGE^BGP8DP1C
Q
IREG ;EP
I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDR(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IEDA ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:3,6:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
D I1AGE^BGP8DP14
Q
IASCRN ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2,5,6,7,8,9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q:BGPRTYPE'=4
Q:BGPINDG="W"
D I1AGE^BGP8DP8
Q
IHIV ;
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
;D I1AGE^BGP8DP1H
Q
PHYACT ;
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDR(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
D I1AGE^BGP8PDLT
Q
SBI ;
G ^BGP8DP1O
I9 ;EP
;K BGPQUIT
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:17 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
S BGPNODEN=1
F BGPPC1=$P(^BGPINDR(BGPIC,12),U,6)_".18" D PI^BGP8DP2 Q:BGPQUIT
K BGPNODEN
;D I1AGE^BGP8DP19
Q
I12 ;EP
D H1^BGP8DPH
F BGPPC1="12.1","12.2","12.3" Q:BGPQUIT D PI
F BGPPC1="12.4","12.5" Q:BGPQUIT W ! D PI
F BGPPC1="12.6","12.7" Q:BGPQUIT D PI
Q
I13 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I14 ;EP
I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I007 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I008 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:5 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IB ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IH ;EP
D H1^BGP8DPH
I BGPRTYPE'=9 D I 1
.S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
.D I1AGE^BGP8DP12
Q
I91 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
D I1AGE^BGP8DP1A
;D H1^BGP8DPH
;ACTIVE CLINICAL
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=7:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q:BGPRTYPE'=4
D I1AGE^BGP8DP13
;S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IG ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI W !
Q
IF ;EP
I '$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IA ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:18 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
ICRSAMM ;EP 23
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I031A ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:14 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
ID ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I0302 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I0303 ;EP
I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I0302A ;EP
I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IHEDBBH ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IHEDPBH ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IHEDCHM ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IE2 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IE1 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IK ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IOMW ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IRAO ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
II ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IAS ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDR(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IAA ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDR(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
D ^BGP8DP1L
Q
IMTA ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1,2,4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
D ^BGP8DP1M
D ^BGP8DP1N
Q
IL ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IMS ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IC2 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IAST1 ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:12 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IRAR ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IHEDCWP ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
IHEDURI ;EP
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
I28 ;EP
I '$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
WASS ;
I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
D H1^BGP8DPH
S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
D ^BGP8DP1S
;I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
;D H1^BGP8DPH
;S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
Q
PI ;EP
D PI^BGP8DP1C
Q
BGP8DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 ;
I1 ;EP
+1 IF '$GET(BGPSUMON)
DO H1^BGP8DPH
I1A1 ;
+1 IF BGPINDG'="E"
FOR BGPPC1="1.1","1.2","1.3"
IF BGPQUIT
QUIT
DO PI
+2 IF BGPINDG="E"
FOR BGPPC1="1.4"
DO PI
+3 IF BGPINDG'="E"
DO I1AGE^BGP8DP1C
+4 QUIT
IREG ;EP
+1 IF $Y>(BGPIOSL-13)
IF '$GET(BGPSUMON)
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
WRITE !!,^BGPINDR(BGPIC,53,1,0)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
WRITE !,^BGPINDR(BGPIC,53,2,0)
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:$PIECE(^BGPINDR(BGPIC,0),U,13)
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 QUIT
IEDA ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:3,6:1:8
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 DO I1AGE^BGP8DP14
+4 QUIT
IASCRN ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2,5,6,7,8,9
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 IF BGPRTYPE'=4
QUIT
+4 IF BGPINDG="W"
QUIT
+5 DO I1AGE^BGP8DP8
+6 QUIT
IHIV ;
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:8
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 ;D I1AGE^BGP8DP1H
+4 QUIT
PHYACT ;
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:$PIECE(^BGPINDR(BGPIC,0),U,13)
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 DO I1AGE^BGP8PDLT
+4 QUIT
SBI ;
+1 GOTO ^BGP8DP1O
I9 ;EP
+1 ;K BGPQUIT
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:17
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 SET BGPNODEN=1
+5 FOR BGPPC1=$PIECE(^BGPINDR(BGPIC,12),U,6)_".18"
DO PI^BGP8DP2
IF BGPQUIT
QUIT
+6 KILL BGPNODEN
+7 ;D I1AGE^BGP8DP19
+8 QUIT
I12 ;EP
+1 DO H1^BGP8DPH
+2 FOR BGPPC1="12.1","12.2","12.3"
IF BGPQUIT
QUIT
DO PI
+3 FOR BGPPC1="12.4","12.5"
IF BGPQUIT
QUIT
WRITE !
DO PI
+4 FOR BGPPC1="12.6","12.7"
IF BGPQUIT
QUIT
DO PI
+5 QUIT
I13 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:3
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
I14 ;EP
+1 IF $Y>(BGPIOSL-13)
IF '$GET(BGPSUMON)
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
WRITE !!,^BGPINDR(BGPIC,53,1,0)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
WRITE !,^BGPINDR(BGPIC,53,2,0)
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:3
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 QUIT
I007 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:7
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
I008 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:5
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IB ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:6
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IH ;EP
+1 DO H1^BGP8DPH
+2 IF BGPRTYPE'=9
Begin DoDot:1
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:6
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 DO I1AGE^BGP8DP12
End DoDot:1
IF 1
+5 QUIT
I91 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:3
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 DO I1AGE^BGP8DP1A
+4 ;D H1^BGP8DPH
+5 ;ACTIVE CLINICAL
+6 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=7:1:9
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+7 IF BGPRTYPE'=4
QUIT
+8 DO I1AGE^BGP8DP13
+9 ;S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
+10 QUIT
IG ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:3
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
WRITE !
+3 QUIT
IF ;EP
+1 IF '$GET(BGPSUMON)
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
WRITE !!,^BGPINDR(BGPIC,53,1,0)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
WRITE !,^BGPINDR(BGPIC,53,2,0)
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:3
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 QUIT
IA ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:18
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
ICRSAMM ;EP 23
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
I031A ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:14
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
ID ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:9
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
I0302 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:9
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
I0303 ;EP
+1 IF $Y>(BGPIOSL-13)
IF '$GET(BGPSUMON)
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
WRITE !!,^BGPINDR(BGPIC,53,1,0)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
WRITE !,^BGPINDR(BGPIC,53,2,0)
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:3
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 QUIT
I0302A ;EP
+1 IF $Y>(BGPIOSL-13)
IF '$GET(BGPSUMON)
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
WRITE !!,^BGPINDR(BGPIC,53,1,0)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
WRITE !,^BGPINDR(BGPIC,53,2,0)
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:4
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 QUIT
IHEDBBH ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:6
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IHEDPBH ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:6
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IHEDCHM ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:6
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IE2 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:1
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IE1 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:1
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IK ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:6
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IOMW ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IRAO ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
II ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IAS ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:$PIECE(^BGPINDR(BGPIC,0),U,13)
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IAA ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:$PIECE(^BGPINDR(BGPIC,0),U,13)
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 DO ^BGP8DP1L
+4 QUIT
IMTA ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1,2,4
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 DO ^BGP8DP1M
+4 DO ^BGP8DP1N
+5 QUIT
IL ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IMS ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IC2 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IAST1 ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:12
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IRAR ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IHEDCWP ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
IHEDURI ;EP
+1 DO H1^BGP8DPH
+2 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+3 QUIT
I28 ;EP
+1 IF '$GET(BGPSUMON)
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
WRITE !!,^BGPINDR(BGPIC,53,1,0)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
WRITE !,^BGPINDR(BGPIC,53,2,0)
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:2
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 QUIT
WASS ;
+1 IF $Y>(BGPIOSL-13)
IF '$GET(BGPSUMON)
DO HEADER^BGP8DPH
IF BGPQUIT
QUIT
WRITE !!,^BGPINDR(BGPIC,53,1,0)
IF $DATA(^BGPINDR(BGPIC,53,2,0))
WRITE !,^BGPINDR(BGPIC,53,2,0)
+2 DO H1^BGP8DPH
+3 SET BGPORDP=$PIECE(^BGPINDR(BGPIC,12),U,6)
FOR BGPORDP1=1:1:6
SET BGPPC1=BGPORDP_"."_BGPORDP1
IF BGPQUIT
QUIT
DO PI
+4 DO ^BGP8DP1S
+5 ;I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP8DPH Q:BGPQUIT W !!,^BGPINDR(BGPIC,53,1,0) W:$D(^BGPINDR(BGPIC,53,2,0)) !,^BGPINDR(BGPIC,53,2,0)
+6 ;D H1^BGP8DPH
+7 ;S BGPORDP=$P(^BGPINDR(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
+8 QUIT
PI ;EP
+1 DO PI^BGP8DP1C
+2 QUIT
