- 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