- BGP9DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2008 12:55 PM ;
- ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
- ;
- ;
- I1 ;EP
- I '$G(BGPSUMON) D H1^BGP9DPH
- I1A1 ;
- I BGPINDT'="E" F BGPPC1="1.1","1.2","1.3" Q:BGPQUIT D PI
- I BGPINDT="E" F BGPPC1="1.4" D PI
- I BGPINDT'="E" D I1AGE^BGP9DP1C
- Q
- IREG ;EP
- I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP9DPH Q:BGPQUIT W !!,^BGPINDN(BGPIC,53,1,0) W:$D(^BGPINDN(BGPIC,53,2,0)) !,^BGPINDN(BGPIC,53,2,0)
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:$P(^BGPINDN(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I9 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP9DP19
- Q
- I12 ;EP
- D H1^BGP9DPH
- 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^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),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^BGP9DPH Q:BGPQUIT W !!,^BGPINDN(BGPIC,53,1,0) W:$D(^BGPINDN(BGPIC,53,2,0)) !,^BGPINDN(BGPIC,53,2,0)
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I007 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I008 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IB ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IH ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:6,10:1:15 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP9DP12
- Q
- IG ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI W !
- Q
- IF ;EP
- I '$G(BGPSUMON) D HEADER^BGP9DPH Q:BGPQUIT W !!,^BGPINDN(BGPIC,53,1,0) W:$D(^BGPINDN(BGPIC,53,2,0)) !,^BGPINDN(BGPIC,53,2,0)
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IA ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:18 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ICRSAMM ;EP 23
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I031A ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:13 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ID ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I0302 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),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^BGP9DPH Q:BGPQUIT W !!,^BGPINDN(BGPIC,53,1,0) W:$D(^BGPINDN(BGPIC,53,2,0)) !,^BGPINDN(BGPIC,53,2,0)
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),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^BGP9DPH Q:BGPQUIT W !!,^BGPINDN(BGPIC,53,1,0) W:$D(^BGPINDN(BGPIC,53,2,0)) !,^BGPINDN(BGPIC,53,2,0)
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDBBH ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDPBH ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCHM ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE2 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE1 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IK ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IOMW ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAO ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- II ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAS ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IL ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IMS ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IC2 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAST1 ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:12 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAR ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCWP ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDURI ;EP
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I28 ;EP
- I '$G(BGPSUMON) D HEADER^BGP9DPH Q:BGPQUIT W !!,^BGPINDN(BGPIC,53,1,0) W:$D(^BGPINDN(BGPIC,53,2,0)) !,^BGPINDN(BGPIC,53,2,0)
- D H1^BGP9DPH
- S BGPORDP=$P(^BGPINDN(BGPIC,0),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- PI ;EP
- D PI^BGP9DP1C
- Q
- BGP9DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2008 12:55 PM ;
- +1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
- +2 ;
- +3 ;
- I1 ;EP
- +1 IF '$GET(BGPSUMON)
- DO H1^BGP9DPH
- I1A1 ;
- +1 IF BGPINDT'="E"
- FOR BGPPC1="1.1","1.2","1.3"
- IF BGPQUIT
- QUIT
- DO PI
- +2 IF BGPINDT="E"
- FOR BGPPC1="1.4"
- DO PI
- +3 IF BGPINDT'="E"
- DO I1AGE^BGP9DP1C
- +4 QUIT
- IREG ;EP
- +1 IF $Y>(BGPIOSL-13)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP9DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDN(BGPIC,53,1,0)
- IF $DATA(^BGPINDN(BGPIC,53,2,0))
- WRITE !,^BGPINDN(BGPIC,53,2,0)
- +2 DO H1^BGP9DPH
- +3 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDN(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- I9 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:1
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP9DP19
- +4 QUIT
- I12 ;EP
- +1 DO H1^BGP9DPH
- +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^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),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^BGP9DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDN(BGPIC,53,1,0)
- IF $DATA(^BGPINDN(BGPIC,53,2,0))
- WRITE !,^BGPINDN(BGPIC,53,2,0)
- +2 DO H1^BGP9DPH
- +3 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:3
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- I007 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- I008 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IB ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IH ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:6,10:1:15
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP9DP12
- +4 QUIT
- IG ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),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^BGP9DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDN(BGPIC,53,1,0)
- IF $DATA(^BGPINDN(BGPIC,53,2,0))
- WRITE !,^BGPINDN(BGPIC,53,2,0)
- +2 DO H1^BGP9DPH
- +3 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:3
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- IA ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:18
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- ICRSAMM ;EP 23
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- I031A ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:13
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- ID ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:9
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- I0302 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),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^BGP9DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDN(BGPIC,53,1,0)
- IF $DATA(^BGPINDN(BGPIC,53,2,0))
- WRITE !,^BGPINDN(BGPIC,53,2,0)
- +2 DO H1^BGP9DPH
- +3 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),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^BGP9DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDN(BGPIC,53,1,0)
- IF $DATA(^BGPINDN(BGPIC,53,2,0))
- WRITE !,^BGPINDN(BGPIC,53,2,0)
- +2 DO H1^BGP9DPH
- +3 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- IHEDBBH ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IHEDPBH ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IHEDCHM ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IE2 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:1
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IE1 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:1
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IK ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IOMW ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IRAO ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- II ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IAS ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:8
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IL ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IMS ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IC2 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IAST1 ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:12
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IRAR ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IHEDCWP ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IHEDURI ;EP
- +1 DO H1^BGP9DPH
- +2 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),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^BGP9DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDN(BGPIC,53,1,0)
- IF $DATA(^BGPINDN(BGPIC,53,2,0))
- WRITE !,^BGPINDN(BGPIC,53,2,0)
- +2 DO H1^BGP9DPH
- +3 SET BGPORDP=$PIECE(^BGPINDN(BGPIC,0),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- PI ;EP
- +1 DO PI^BGP9DP1C
- +2 QUIT
