BGPDP ; IHS/CMI/LAB - IHS gpra print ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
PRINT ;
D ^BGPDH
S BGPGPG=0
S BGPQUIT=""
D PRINT1
Q:BGPQUIT
Q
;
PRINT1 ;EP
I $D(BGPIND(1)) D I1^BGPDP1 Q:BGPQUIT
I $D(BGPIND(2)) D I1B^BGPDP1B Q:BGPQUIT
I $D(BGPIND(3)) D I2A^BGPDP2 Q:BGPQUIT
I $D(BGPIND(4)) D I2B^BGPDP2 Q:BGPQUIT
I $D(BGPIND(5)) D I2C^BGPDP2 Q:BGPQUIT
I $D(BGPIND(6)) D I3A^BGPDP3 Q:BGPQUIT
I $D(BGPIND(7)) D I3B^BGPDP3 Q:BGPQUIT
I $D(BGPIND(8)) D I3C^BGPDP3 Q:BGPQUIT
I $D(BGPIND(9)) D I4A^BGPDP4 Q:BGPQUIT
I $D(BGPIND(10)) D I4B^BGPDP4 Q:BGPQUIT
I $D(BGPIND(11)) D I4C^BGPDP4 Q:BGPQUIT
I $D(BGPIND(12)) D I5A^BGPDP5 Q:BGPQUIT
I $D(BGPIND(13)) D I5B^BGPDP5 Q:BGPQUIT
I $D(BGPIND(14)) D I5C^BGPDP5 Q:BGPQUIT
I $D(BGPIND(15)) D I6^BGPDP6 Q:BGPQUIT
I $D(BGPIND(16)) D I6A^BGPDP6 Q:BGPQUIT
I $D(BGPIND(17)) D I7^BGPDP7 Q:BGPQUIT
I $D(BGPIND(18)) D I8^BGPDP8 Q:BGPQUIT
I $D(BGPIND(19)) D I12^BGPDP12 Q:BGPQUIT
I $D(BGPIND(20)) D I13^BGPDP13 Q:BGPQUIT
I $D(BGPIND(21)) D I14^BGPDP14 Q:BGPQUIT
I $D(BGPIND(22)) D I22^BGPDP22 Q:BGPQUIT
I $D(BGPIND(23)) D I23^BGPDP23 Q:BGPQUIT
I $D(BGPIND(24)) D I24^BGPDP24 Q:BGPQUIT
I $D(BGPIND(25)) D I29^BGPDP29 Q:BGPQUIT
I $D(BGPIND(26)) D I30^BGPDP30 Q:BGPQUIT
I $D(BGPIND(27)) D IA^BGPDPA Q:BGPQUIT
I $D(BGPIND(28)) D IB^BGPDPB Q:BGPQUIT
I $D(BGPIND(29)) D IC^BGPDPC Q:BGPQUIT
I $D(BGPIND(30)) D ID^BGPDPD Q:BGPQUIT
D ^BGPDS
D EXIT
Q
EXIT ;
I '$G(BGPAREAA) K ^XTMP("BGPD",BGPJ,BGPH)
I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO",DIR("A")="End of report. Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
V(R,N,P) ;
NEW Y
I $G(BGPAREAA),'$G(BGPSUMR) G VA
Q $P($G(^BGPD(R,N)),U,P)
VA ;
NEW X,C,V,MT,FT,M,F,B S X=0,C="" F S X=$O(BGPSUL(X)) Q:X'=+X D
.S V=$P($G(^BGPD(X,N)),U,P)
.I C="" S C=V Q
.S MT=$P(C,"!"),FT=$P(C,"!",2),M=$P(V,"!"),F=$P(V,"!",2)
.F B=1:1:6 S $P(MT,"~",B)=$P(MT,"~",B)+$P(M,"~",B)
.F B=1:1:6 S $P(FT,"~",B)=$P(FT,"~",B)+$P(F,"~",B)
.S C=MT_"!"_FT
.Q
Q C
C(X,X2,X3) ;
D COMMA^%DTC
Q X
BGPDP ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
PRINT ;
+1 DO ^BGPDH
+2 SET BGPGPG=0
+3 SET BGPQUIT=""
+4 DO PRINT1
+5 IF BGPQUIT
QUIT
+6 QUIT
+7 ;
PRINT1 ;EP
+1 IF $DATA(BGPIND(1))
DO I1^BGPDP1
IF BGPQUIT
QUIT
+2 IF $DATA(BGPIND(2))
DO I1B^BGPDP1B
IF BGPQUIT
QUIT
+3 IF $DATA(BGPIND(3))
DO I2A^BGPDP2
IF BGPQUIT
QUIT
+4 IF $DATA(BGPIND(4))
DO I2B^BGPDP2
IF BGPQUIT
QUIT
+5 IF $DATA(BGPIND(5))
DO I2C^BGPDP2
IF BGPQUIT
QUIT
+6 IF $DATA(BGPIND(6))
DO I3A^BGPDP3
IF BGPQUIT
QUIT
+7 IF $DATA(BGPIND(7))
DO I3B^BGPDP3
IF BGPQUIT
QUIT
+8 IF $DATA(BGPIND(8))
DO I3C^BGPDP3
IF BGPQUIT
QUIT
+9 IF $DATA(BGPIND(9))
DO I4A^BGPDP4
IF BGPQUIT
QUIT
+10 IF $DATA(BGPIND(10))
DO I4B^BGPDP4
IF BGPQUIT
QUIT
+11 IF $DATA(BGPIND(11))
DO I4C^BGPDP4
IF BGPQUIT
QUIT
+12 IF $DATA(BGPIND(12))
DO I5A^BGPDP5
IF BGPQUIT
QUIT
+13 IF $DATA(BGPIND(13))
DO I5B^BGPDP5
IF BGPQUIT
QUIT
+14 IF $DATA(BGPIND(14))
DO I5C^BGPDP5
IF BGPQUIT
QUIT
+15 IF $DATA(BGPIND(15))
DO I6^BGPDP6
IF BGPQUIT
QUIT
+16 IF $DATA(BGPIND(16))
DO I6A^BGPDP6
IF BGPQUIT
QUIT
+17 IF $DATA(BGPIND(17))
DO I7^BGPDP7
IF BGPQUIT
QUIT
+18 IF $DATA(BGPIND(18))
DO I8^BGPDP8
IF BGPQUIT
QUIT
+19 IF $DATA(BGPIND(19))
DO I12^BGPDP12
IF BGPQUIT
QUIT
+20 IF $DATA(BGPIND(20))
DO I13^BGPDP13
IF BGPQUIT
QUIT
+21 IF $DATA(BGPIND(21))
DO I14^BGPDP14
IF BGPQUIT
QUIT
+22 IF $DATA(BGPIND(22))
DO I22^BGPDP22
IF BGPQUIT
QUIT
+23 IF $DATA(BGPIND(23))
DO I23^BGPDP23
IF BGPQUIT
QUIT
+24 IF $DATA(BGPIND(24))
DO I24^BGPDP24
IF BGPQUIT
QUIT
+25 IF $DATA(BGPIND(25))
DO I29^BGPDP29
IF BGPQUIT
QUIT
+26 IF $DATA(BGPIND(26))
DO I30^BGPDP30
IF BGPQUIT
QUIT
+27 IF $DATA(BGPIND(27))
DO IA^BGPDPA
IF BGPQUIT
QUIT
+28 IF $DATA(BGPIND(28))
DO IB^BGPDPB
IF BGPQUIT
QUIT
+29 IF $DATA(BGPIND(29))
DO IC^BGPDPC
IF BGPQUIT
QUIT
+30 IF $DATA(BGPIND(30))
DO ID^BGPDPD
IF BGPQUIT
QUIT
+31 DO ^BGPDS
+32 DO EXIT
+33 QUIT
EXIT ;
+1 IF '$GET(BGPAREAA)
KILL ^XTMP("BGPD",BGPJ,BGPH)
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
SET DIR("A")="End of report. Press ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
V(R,N,P) ;
+1 NEW Y
+2 IF $GET(BGPAREAA)
IF '$GET(BGPSUMR)
GOTO VA
+3 QUIT $PIECE($GET(^BGPD(R,N)),U,P)
VA ;
+1 NEW X,C,V,MT,FT,M,F,B
SET X=0
SET C=""
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET V=$PIECE($GET(^BGPD(X,N)),U,P)
+3 IF C=""
SET C=V
QUIT
+4 SET MT=$PIECE(C,"!")
SET FT=$PIECE(C,"!",2)
SET M=$PIECE(V,"!")
SET F=$PIECE(V,"!",2)
+5 FOR B=1:1:6
SET $PIECE(MT,"~",B)=$PIECE(MT,"~",B)+$PIECE(M,"~",B)
+6 FOR B=1:1:6
SET $PIECE(FT,"~",B)=$PIECE(FT,"~",B)+$PIECE(F,"~",B)
+7 SET C=MT_"!"_FT
+8 QUIT
End DoDot:1
+9 QUIT C
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
