- BGP6DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
- ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- ;
- ;
- I1 ;EP
- I '$G(BGPSUMON) D H1^BGP6DPH
- I1A1 ;
- I BGPINDM'="E" F BGPPC1="1.1","1.2","1.3" Q:BGPQUIT D PI
- I BGPINDM="E" F BGPPC1="1.4" D PI
- I BGPINDM'="E" D I1AGE^BGP6DP1C
- Q
- IREG ;EP
- I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IEDA ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3,6:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP6DP14
- Q
- IASCRN ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP6DP8
- Q
- IHIV ;
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- ;D I1AGE^BGP6DP1H
- Q
- PHYACT ;
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP6PDLT
- Q
- SBI ;
- G ^BGP6DP1O
- I9 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1,3,4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- S BGPNODEN=1
- F BGPPC1=$P(^BGPINDM(BGPIC,12),U,6)_".5" D PI^BGP6DP2 Q:BGPQUIT
- K BGPNODEN
- D I1AGE^BGP6DP19
- Q
- I12 ;EP
- D H1^BGP6DPH
- 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^BGP6DPH
- S BGPORDP=$P(^BGPINDM(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^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I007 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I008 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:5 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IB ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IH ;EP
- D H1^BGP6DPH
- I BGPRTYPE'=9 D I 1
- .S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- .D I1AGE^BGP6DP12
- Q
- I91 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D I1AGE^BGP6DP13
- ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IG ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(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^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IA ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:18 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ICRSAMM ;EP 23
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I031A ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:14 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- ID ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- I0302 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(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^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(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^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDBBH ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDPBH ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCHM ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE2 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IE1 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IK ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IOMW ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAO ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- II ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAS ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAA ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP6DP1L
- Q
- IMTA ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1,2,4 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP6DP1M
- D ^BGP6DP1N
- Q
- IL ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IMS ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IC2 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IAST1 ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:12 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IRAR ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDCWP ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- IHEDURI ;EP
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(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^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(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^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- D H1^BGP6DPH
- S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- D ^BGP6DP1S
- ;I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- ;D H1^BGP6DPH
- ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- Q
- PI ;EP
- D PI^BGP6DP1C
- Q
- BGP6DP1 ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM ;
- +1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- +2 ;
- +3 ;
- I1 ;EP
- +1 IF '$GET(BGPSUMON)
- DO H1^BGP6DPH
- I1A1 ;
- +1 IF BGPINDM'="E"
- FOR BGPPC1="1.1","1.2","1.3"
- IF BGPQUIT
- QUIT
- DO PI
- +2 IF BGPINDM="E"
- FOR BGPPC1="1.4"
- DO PI
- +3 IF BGPINDM'="E"
- DO I1AGE^BGP6DP1C
- +4 QUIT
- IREG ;EP
- +1 IF $Y>(BGPIOSL-13)
- IF '$GET(BGPSUMON)
- DO HEADER^BGP6DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDM(BGPIC,53,1,0)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- WRITE !,^BGPINDM(BGPIC,53,2,0)
- +2 DO H1^BGP6DPH
- +3 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDM(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 QUIT
- IEDA ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:3,6:1:8
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP6DP14
- +4 QUIT
- IASCRN ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:2
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP6DP8
- +4 QUIT
- IHIV ;
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 ;D I1AGE^BGP6DP1H
- +4 QUIT
- PHYACT ;
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDM(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP6PDLT
- +4 QUIT
- SBI ;
- +1 GOTO ^BGP6DP1O
- I9 ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1,3,4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 SET BGPNODEN=1
- +4 FOR BGPPC1=$PIECE(^BGPINDM(BGPIC,12),U,6)_".5"
- DO PI^BGP6DP2
- IF BGPQUIT
- QUIT
- +5 KILL BGPNODEN
- +6 DO I1AGE^BGP6DP19
- +7 QUIT
- I12 ;EP
- +1 DO H1^BGP6DPH
- +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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDM(BGPIC,53,1,0)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- WRITE !,^BGPINDM(BGPIC,53,2,0)
- +2 DO H1^BGP6DPH
- +3 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 IF BGPRTYPE'=9
- Begin DoDot:1
- +3 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 DO I1AGE^BGP6DP12
- End DoDot:1
- IF 1
- +5 QUIT
- I91 ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO I1AGE^BGP6DP13
- +4 ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- +5 QUIT
- IG ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDM(BGPIC,53,1,0)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- WRITE !,^BGPINDM(BGPIC,53,2,0)
- +2 DO H1^BGP6DPH
- +3 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDM(BGPIC,53,1,0)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- WRITE !,^BGPINDM(BGPIC,53,2,0)
- +2 DO H1^BGP6DPH
- +3 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDM(BGPIC,53,1,0)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- WRITE !,^BGPINDM(BGPIC,53,2,0)
- +2 DO H1^BGP6DPH
- +3 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDM(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 QUIT
- IAA ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:$PIECE(^BGPINDM(BGPIC,0),U,13)
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO ^BGP6DP1L
- +4 QUIT
- IMTA ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1,2,4
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +3 DO ^BGP6DP1M
- +4 DO ^BGP6DP1N
- +5 QUIT
- IL ;EP
- +1 DO H1^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- +2 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDM(BGPIC,53,1,0)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- WRITE !,^BGPINDM(BGPIC,53,2,0)
- +2 DO H1^BGP6DPH
- +3 SET BGPORDP=$PIECE(^BGPINDM(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^BGP6DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPINDM(BGPIC,53,1,0)
- IF $DATA(^BGPINDM(BGPIC,53,2,0))
- WRITE !,^BGPINDM(BGPIC,53,2,0)
- +2 DO H1^BGP6DPH
- +3 SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)
- FOR BGPORDP1=1:1:6
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- IF BGPQUIT
- QUIT
- DO PI
- +4 DO ^BGP6DP1S
- +5 ;I $Y>(BGPIOSL-13),'$G(BGPSUMON) D HEADER^BGP6DPH Q:BGPQUIT W !!,^BGPINDM(BGPIC,53,1,0) W:$D(^BGPINDM(BGPIC,53,2,0)) !,^BGPINDM(BGPIC,53,2,0)
- +6 ;D H1^BGP6DPH
- +7 ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT D PI
- +8 QUIT
- PI ;EP
- +1 DO PI^BGP6DP1C
- +2 QUIT
