- BGP7DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- ;
- I1 ;EP
- I '$G(BGPSUMON) D H1^BGP7DPH
- 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^BGP7DP1C
- Q
- IREG ;EP
- I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDG(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IEDA ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:3,6:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP7DP14
- Q
- IASCRN ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(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^BGP7DP8
- Q
- IHIV ;
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- ;D I1AGE^BGP7DP1H
- Q
- PHYACT ;
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDG(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP7PDLT
- Q
- SBI ;
- G ^BGP7DP1O
- I9 ;EP
- ;K BGPQUIT
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:16 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- S BGPNODEN=1
- F BGPPC1=$P(^BGPINDG(BGPIC,12),U,6)_".17" D PI^BGP7DP2 Q:BGPQUIT
- K BGPNODEN
- ;D I1AGE^BGP7DP19
- Q
- I12 ;EP
- D H1^BGP7DPH
- 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^BGP7DPH
- S BGPORDP=$P(^BGPINDG(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^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I007 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I008 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:5 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IB ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IH ;EP
- D H1^BGP7DPH
- I BGPRTYPE'=9 D I 1
- .S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- .D I1AGE^BGP7DP12
- Q
- I91 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP7DP13
- ;S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IG ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(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^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IA ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:18 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ICRSAMM ;EP 23
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I031A ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:14 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ID ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I0302 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(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^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(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^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDBBH ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDPBH ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCHM ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE2 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE1 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IK ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IOMW ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAO ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- II ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAS ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDG(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAA ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDG(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP7DP1L
- Q
- IMTA ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1,2,4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP7DP1M
- D ^BGP7DP1N
- Q
- IL ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IMS ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IC2 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAST1 ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:12 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAR ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCWP ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDURI ;EP
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(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^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(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^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- D H1^BGP7DPH
- S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP7DP1S
- ;I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- ;D H1^BGP7DPH
- ;S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- PI ;EP
- D PI^BGP7DP1C
- Q
- BGP7DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +2 ;
- +3 ;
- I1 ;EP
- +1 IF '$GET(BGPSUMON)
- DO H1^BGP7DPH
- 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^BGP7DP1C
- +4 QUIT
- IREG ;EP
- +1 IF $Y>(BGPIOSL-13)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDG(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- IEDA ;EP
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:3,6:1:8
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP7DP14
- +4 QUIT
- IASCRN ;EP
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DP8
- +6 QUIT
- IHIV ;
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:8
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 ;D I1AGE^BGP7DP1H
- +4 QUIT
- PHYACT ;
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDG(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP7PDLT
- +4 QUIT
- SBI ;
- +1 GOTO ^BGP7DP1O
- I9 ;EP
- +1 ;K BGPQUIT
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:16
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 SET BGPNODEN=1
- +5 FOR BGPPC1=$PIECE(^BGPINDG(BGPIC,12),U,6)_".17"
- DO PI^BGP7DP2
- IF BGPQUIT
- QUIT
- +6 KILL BGPNODEN
- +7 ;D I1AGE^BGP7DP19
- +8 QUIT
- I12 ;EP
- +1 DO H1^BGP7DPH
- +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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 IF BGPRTYPE'=9
- Begin DoDot:1
- +3 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 DO I1AGE^BGP7DP12
- End DoDot:1
- IF 1
- +5 QUIT
- I91 ;EP
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP7DP13
- +4 ;S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- +5 QUIT
- IG ;EP
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDG(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IAA ;EP
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDG(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO ^BGP7DP1L
- +4 QUIT
- IMTA ;EP
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1,2,4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO ^BGP7DP1M
- +4 DO ^BGP7DP1N
- +5 QUIT
- IL ;EP
- +1 DO H1^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- +2 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(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^BGP7DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDG(BGPIC,53,1,0)
- IF $DATA(^BGPINDG(BGPIC,53,2,0))
- WRITE !,^BGPINDG(BGPIC,53,2,0)
- +2 DO H1^BGP7DPH
- +3 SET BGPORDP=$PIECE(^BGPINDG(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 DO ^BGP7DP1S
- +5 ;I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP7DPH Q:BGPQUIT W !!,^BGPINDG(BGPIC,53,1,0) W:$D(^BGPINDG(BGPIC,53,2,0)) !,^BGPINDG(BGPIC,53,2,0)
- +6 ;D H1^BGP7DPH
- +7 ;S BGPORDP=$P(^BGPINDG(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- +8 QUIT
- PI ;EP
- +1 DO PI^BGP7DP1C
- +2 QUIT
