- DGPMBSP6 ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90
- ;;5.3;Registration;**170**;Aug 13, 1993
- ;
- A Q:'CT
- N FY0
- ;
- S X="C U M U L A T I V E T O T A L S"
- ;
- W ! W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
- S X1=RM-$L(X)\2
- W !?0,"|",?X1,X,?130,"|"
- W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
- W !?0,"|",?26,"|",?40,"| Interward",?54,"|Interservice",?68,"|",?82,"| Interward",?96,"|Interservice",?110,"|",?117,"Patient",?130,"|"
- W !?0,"|",?26,"| Admissions",?40,"| Gains",?54,"| Gains",?68,"| Discharges",?82,"| Losses",?96,"| Losses",?110,"| Days",?130,"|"
- W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
- W !?0,"|",?26,"|"
- S FY0=FY("Y")-1 S:FY0=-1 FY0="99" S:$L(FY0)=1 FY0="0"_FY0
- F C=1:1:14 W $S(C<13:"",1:" ")," FY-",$S('(C#2):FY("Y"),1:FY0)_"|"
- W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
- S I=0
- 1 F I1=0:0 S I=$O(CUM(I)),J=0 Q:I'>0 F J1=0:0 S J=$O(CUM(I,J)) Q:J'>0 D 2
- W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
- ;
- Q Q
- ;
- 2 S X=CUM(I,J),Z=+$O(^DIC(42,"AGL",I,0)),Z=$S('$D(^DIC(42,+Z,1,J,0)):$P(X,"^"),$P(^DIC(42,+Z,1,J,0),"^",5)]"":$P(^DIC(42,+Z,1,J,0),"^",5),1:$P(X,"^"))
- W !?0,"|",$E(Z,1,23),?26,"|" F K=2:1:15 S X1=$S(K<14:6,1:9) W $J(+$P(X,"^",K),X1),"|"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMBSP6 1272 printed Feb 19, 2025@00:15:18 Page 2
- DGPMBSP6 ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90
- +1 ;;5.3;Registration;**170**;Aug 13, 1993
- +2 ;
- A if 'CT
- QUIT
- +1 NEW FY0
- +2 ;
- +3 SET X="C U M U L A T I V E T O T A L S"
- +4 ;
- +5 WRITE !
- if $Y<131
- WRITE ?131,""
- WRITE $CHAR(13)
- if UL["-"
- WRITE !
- FOR L=1:1:131
- WRITE UL
- +6 SET X1=RM-$LENGTH(X)\2
- +7 WRITE !?0,"|",?X1,X,?130,"|"
- +8 if $Y<131
- WRITE ?131,""
- WRITE $CHAR(13)
- if UL["-"
- WRITE !
- FOR L=1:1:131
- WRITE UL
- +9 WRITE !?0,"|",?26,"|",?40,"| Interward",?54,"|Interservice",?68,"|",?82,"| Interward",?96,"|Interservice",?110,"|",?117,"Patient",?130,"|"
- +10 WRITE !?0,"|",?26,"| Admissions",?40,"| Gains",?54,"| Gains",?68,"| Discharges",?82,"| Losses",?96,"| Losses",?110,"| Days",?130,"|"
- +11 if $Y<131
- WRITE ?131,""
- WRITE $CHAR(13)
- if UL["-"
- WRITE !
- FOR L=1:1:131
- WRITE UL
- +12 WRITE !?0,"|",?26,"|"
- +13 SET FY0=FY("Y")-1
- if FY0=-1
- SET FY0="99"
- if $LENGTH(FY0)=1
- SET FY0="0"_FY0
- +14 FOR C=1:1:14
- WRITE $SELECT(C<13:"",1:" ")," FY-",$SELECT('(C#2):FY("Y"),1:FY0)_"|"
- +15 if $Y<131
- WRITE ?131,""
- WRITE $CHAR(13)
- if UL["-"
- WRITE !
- FOR L=1:1:131
- WRITE UL
- +16 SET I=0
- 1 FOR I1=0:0
- SET I=$ORDER(CUM(I))
- SET J=0
- if I'>0
- QUIT
- FOR J1=0:0
- SET J=$ORDER(CUM(I,J))
- if J'>0
- QUIT
- DO 2
- +1 if $Y<131
- WRITE ?131,""
- WRITE $CHAR(13)
- if UL["-"
- WRITE !
- FOR L=1:1:131
- WRITE UL
- +2 ;
- Q QUIT
- +1 ;
- 2 SET X=CUM(I,J)
- SET Z=+$ORDER(^DIC(42,"AGL",I,0))
- SET Z=$SELECT('$DATA(^DIC(42,+Z,1,J,0)):$PIECE(X,"^"),$PIECE(^DIC(42,+Z,1,J,0),"^",5)]"":$PIECE(^DIC(42,+Z,1,J,0),"^",5),1:$PIECE(X,"^"))
- +1 WRITE !?0,"|",$EXTRACT(Z,1,23),?26,"|"
- FOR K=2:1:15
- SET X1=$SELECT(K<14:6,1:9)
- WRITE $JUSTIFY(+$PIECE(X,"^",K),X1),"|"
- +2 QUIT