- BGP2DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
- ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- ;
- ;
- I1 ;EP
- I '$G(BGPSUMON) D H1^BGP2DPH
- I1A1 ;
- I BGPINDW'="E" F BGPPC1="1.1","1.2","1.3" Q:BGPQUIT D PI
- I BGPINDW="E" F BGPPC1="1.4" D PI
- I BGPINDW'="E" D I1AGE^BGP2DP1C
- Q
- IREG ;EP
- I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP2DPH Q:BGPQUIT W !!,^BGPINDW(BGPIC,53,1,0) W:$D(^BGPINDW(BGPIC,53,2,0)) !,^BGPINDW(BGPIC,53,2,0)
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDW(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IEDA ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:3,6:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP2DP14
- Q
- IASCRN ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP2DP8
- Q
- IHIV ;
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:4,8,9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP2DP1H
- Q
- PHYACT ;
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDW(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP2PDLT
- Q
- I9 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1,3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP2DP19
- Q
- I12 ;EP
- D H1^BGP2DPH
- 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^BGP2DPH
- S BGPORDP=$P(^BGPINDW(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^BGP2DPH Q:BGPQUIT W !!,^BGPINDW(BGPIC,53,1,0) W:$D(^BGPINDW(BGPIC,53,2,0)) !,^BGPINDW(BGPIC,53,2,0)
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I007 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I008 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:5 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IB ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IH ;EP
- D H1^BGP2DPH
- I BGPRTYPE'=9 D I 1
- .S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- .D I1AGE^BGP2DP12
- Q
- I91 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP2DP13
- Q
- IG ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI W !
- Q
- IF ;EP
- I '$G(BGPSUMON) D HEADER^BGP2DPH Q:BGPQUIT W !!,^BGPINDW(BGPIC,53,1,0) W:$D(^BGPINDW(BGPIC,53,2,0)) !,^BGPINDW(BGPIC,53,2,0)
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IA ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:18 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ICRSAMM ;EP 23
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I031A ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:13 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ID ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I0302 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(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^BGP2DPH Q:BGPQUIT W !!,^BGPINDW(BGPIC,53,1,0) W:$D(^BGPINDW(BGPIC,53,2,0)) !,^BGPINDW(BGPIC,53,2,0)
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(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^BGP2DPH Q:BGPQUIT W !!,^BGPINDW(BGPIC,53,1,0) W:$D(^BGPINDW(BGPIC,53,2,0)) !,^BGPINDW(BGPIC,53,2,0)
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDBBH ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDPBH ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCHM ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE2 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE1 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IK ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IOMW ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAO ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- II ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAS ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDW(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAA ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDW(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP2DP1L
- Q
- IMTA ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1,2,4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP2DP1M
- D ^BGP2DP1N
- Q
- IL ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IMS ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IC2 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAST1 ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:12 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAR ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCWP ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDURI ;EP
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(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^BGP2DPH Q:BGPQUIT W !!,^BGPINDW(BGPIC,53,1,0) W:$D(^BGPINDW(BGPIC,53,2,0)) !,^BGPINDW(BGPIC,53,2,0)
- D H1^BGP2DPH
- S BGPORDP=$P(^BGPINDW(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- PI ;EP
- D PI^BGP2DP1C
- Q
- BGP2DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
- +1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- +2 ;
- +3 ;
- I1 ;EP
- +1 IF '$GET(BGPSUMON)
- DO H1^BGP2DPH
- I1A1 ;
- +1 IF BGPINDW'="E"
- FOR BGPPC1="1.1","1.2","1.3"
- IF BGPQUIT
- QUIT
- DO PI
- +2 IF BGPINDW="E"
- FOR BGPPC1="1.4"
- DO PI
- +3 IF BGPINDW'="E"
- DO I1AGE^BGP2DP1C
- +4 QUIT
- IREG ;EP
- +1 IF $Y>(BGPIOSL-13)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP2DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDW(BGPIC,53,1,0)
- IF $DATA(^BGPINDW(BGPIC,53,2,0))
- WRITE !,^BGPINDW(BGPIC,53,2,0)
- +2 DO H1^BGP2DPH
- +3 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDW(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- IEDA ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:3,6:1:8
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP2DP14
- +4 QUIT
- IASCRN ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP2DP8
- +4 QUIT
- IHIV ;
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:4,8,9
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP2DP1H
- +4 QUIT
- PHYACT ;
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDW(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP2PDLT
- +4 QUIT
- I9 ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1,3
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP2DP19
- +4 QUIT
- I12 ;EP
- +1 DO H1^BGP2DPH
- +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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDW(BGPIC,53,1,0)
- IF $DATA(^BGPINDW(BGPIC,53,2,0))
- WRITE !,^BGPINDW(BGPIC,53,2,0)
- +2 DO H1^BGP2DPH
- +3 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 IF BGPRTYPE'=9
- Begin DoDot:1
- +3 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 DO I1AGE^BGP2DP12
- End DoDot:1
- IF 1
- +5 QUIT
- I91 ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:3
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP2DP13
- +4 QUIT
- IG ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- WRITE !
- +3 QUIT
- IF ;EP
- +1 IF '$GET(BGPSUMON)
- DO HEADER^BGP2DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDW(BGPIC,53,1,0)
- IF $DATA(^BGPINDW(BGPIC,53,2,0))
- WRITE !,^BGPINDW(BGPIC,53,2,0)
- +2 DO H1^BGP2DPH
- +3 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:13
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- ID ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDW(BGPIC,53,1,0)
- IF $DATA(^BGPINDW(BGPIC,53,2,0))
- WRITE !,^BGPINDW(BGPIC,53,2,0)
- +2 DO H1^BGP2DPH
- +3 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDW(BGPIC,53,1,0)
- IF $DATA(^BGPINDW(BGPIC,53,2,0))
- WRITE !,^BGPINDW(BGPIC,53,2,0)
- +2 DO H1^BGP2DPH
- +3 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDW(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IAA ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDW(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO ^BGP2DP1L
- +4 QUIT
- IMTA ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1,2,4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO ^BGP2DP1M
- +4 DO ^BGP2DP1N
- +5 QUIT
- IL ;EP
- +1 DO H1^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- +2 SET BGPORDP=$PIECE(^BGPINDW(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^BGP2DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDW(BGPIC,53,1,0)
- IF $DATA(^BGPINDW(BGPIC,53,2,0))
- WRITE !,^BGPINDW(BGPIC,53,2,0)
- +2 DO H1^BGP2DPH
- +3 SET BGPORDP=$PIECE(^BGPINDW(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- PI ;EP
- +1 DO PI^BGP2DP1C
- +2 QUIT
