- DGPTODF2 ;ALB/MTC - PTF DRG FREQUENCY REPORT,CONT. ; 9/14/01 4:34pm
- ;;5.3;Registration;**375,1015**;Aug 13, 1993;Build 21
- HEAD I P S %=IOSL-14 F E=$Y:1:% W ! ;I E=(%-1) D DIS^DGPTOD1
- I P D DIS^DGPTOD1 W !!
- W:P ?62,"-",P,"-" W @IOF,!!?10,"Discharge Frequency Rank for ",$S(DGFLAG'["M":G2_" SERVICE",1:"MEDICAL CENTER"),$S(DGFLAG["Spec":" by Specialty",1:"") I 'DGD W " for Active Admissions"
- I DGD W " for " S Y=DGSD+.1 X ^DD("DD") W $P(Y,"@",1)," TO " S Y=DGED X ^DD("DD") W $P(Y,"@",1)
- W ?110,"Printed: " S Y=DT D DT^DIQ W !?15,$S(DGB:"",1:"Not "),"Including Transfer DRGs",!
- W !?11,H3,!?10,H,?50,"Total 1 Total # Total ALOS/",?123,"Average",!?10,H1,?49,"Day Stays Discharges LOS Discharge (*)Total Weight Weight",!
- K E S $P(E,"=",133)="" W E K E
- S P=P+1 Q
- COV K ^UTILITY($J,"DGTC"),DGCPG,DGTCH S DGCPG(1)="DRG FREQUENCY Report by "_DGFLAG,DGCPG(2)=$S(DGD:"for Discharge Dates Between ",1:"Active Admissions")
- I DGD S Y=DGSD+.1 X ^DD("DD") S %=Y,Y=$P(DGED,".") X ^DD("DD") S DGCPG(2)=DGCPG(2)_%_" to "_Y,DGCPG(3)=$S('DGB:"not ",1:"")_"including TRANSFER DRGs"
- S DGTCH="DRG FREQUENCY by "_P3_"^"_P3_"^PAGE #" D C^DGUTL Q
- FD F I=0:0 S I=$O(^UTILITY($J,"DGPTFR","D",I)) Q:I'>0 S J=^(I),S=$S($D(^(I,"AT")):$P(^("AT"),U,3),1:0) D FD1
- I "SB"[DGS,$D(^UTILITY($J,"DGPTFR","SB")) S I=0 F I1=0:0 S I=$O(^UTILITY($J,"DGPTFR","SB",I)) Q:I']"" S S=^(I) F J=0:0 S J=$O(^UTILITY($J,"DGPTFR","SB",I,J)) Q:J'>0 S B=^(J) D E1
- Q
- E1 F D=0:0 S D=$O(^UTILITY($J,"DGPTFR","SB",I,J,D)) Q:D'>0 S D1=^(D),T=$S($D(^(D,"AT")):$P(^("AT"),U,3),1:0),T1=$S($D(^UTILITY($J,"DGPTFR","SB",I,J,D,"BT")):$P(^("BT"),U,4,5)_U_$P(^("BT"),U,2),1:0_U_0),^UTILITY($J,"DGPTFR","FS",I)=S D E2
- Q
- E2 S $P(^(D),U)=+D1+$S($D(^UTILITY($J,"DGPTFR","FS",I,D)):$P(^(D),U),1:0),$P(^(D),U,2)=$P(^(D),U,2)+$P(D1,U,2),$P(^(D),U,3,8)=$P(D1,U,3,8),$P(^(D),U,9)=$P(^(D),U,9)+T,$P(^(D),U,10)=+T1+$P(^(D),U,10),$P(^(D),U,11)=$P(^(D),U,11)+$P(T1,U,2)
- S $P(^(D),U,12)=$P(^UTILITY($J,"DGPTFR","FS",I,D),U,12)+$P(T1,U,3),^UTILITY($J,"DGPTFR","FB",I)=S,^(I,J)=B,^(J,(999999-$P(D1,U,2)),D)=D1_U_T_U_T1 Q
- FD1 S S1=$S($D(^UTILITY($J,"DGPTFR","D",I,"BT")):$P(^("BT"),U,4,5),1:0_U_0),$P(S1,U,3)=$S($D(^("BT")):$P(^("BT"),U,2),1:0)+$P(S1,U,3),^UTILITY($J,"DGPTFR","FD",(999999-$P(J,U,2)),I)=J_U_S_U_S1 Q
- DGPTODF2 ;ALB/MTC - PTF DRG FREQUENCY REPORT,CONT. ; 9/14/01 4:34pm
- +1 ;;5.3;Registration;**375,1015**;Aug 13, 1993;Build 21
- HEAD ;I E=(%-1) D DIS^DGPTOD1
- IF P
- SET %=IOSL-14
- FOR E=$Y:1:%
- WRITE !
- +1 IF P
- DO DIS^DGPTOD1
- WRITE !!
- +2 IF P
- WRITE ?62,"-",P,"-"
- WRITE @IOF,!!?10,"Discharge Frequency Rank for ",$SELECT(DGFLAG'["M":G2_" SERVICE",1:"MEDICAL CENTER"),$SELECT(DGFLAG["Spec":" by Specialty",1:"")
- IF 'DGD
- WRITE " for Active Admissions"
- +3 IF DGD
- WRITE " for "
- SET Y=DGSD+.1
- XECUTE ^DD("DD")
- WRITE $PIECE(Y,"@",1)," TO "
- SET Y=DGED
- XECUTE ^DD("DD")
- WRITE $PIECE(Y,"@",1)
- +4 WRITE ?110,"Printed: "
- SET Y=DT
- DO DT^DIQ
- WRITE !?15,$SELECT(DGB:"",1:"Not "),"Including Transfer DRGs",!
- +5 WRITE !?11,H3,!?10,H,?50,"Total 1 Total # Total ALOS/",?123,"Average",!?10,H1,?49,"Day Stays Discharges LOS Discharge (*)Total Weight Weight",!
- +6 KILL E
- SET $PIECE(E,"=",133)=""
- WRITE E
- KILL E
- +7 SET P=P+1
- QUIT
- COV KILL ^UTILITY($JOB,"DGTC"),DGCPG,DGTCH
- SET DGCPG(1)="DRG FREQUENCY Report by "_DGFLAG
- SET DGCPG(2)=$SELECT(DGD:"for Discharge Dates Between ",1:"Active Admissions")
- +1 IF DGD
- SET Y=DGSD+.1
- XECUTE ^DD("DD")
- SET %=Y
- SET Y=$PIECE(DGED,".")
- XECUTE ^DD("DD")
- SET DGCPG(2)=DGCPG(2)_%_" to "_Y
- SET DGCPG(3)=$SELECT('DGB:"not ",1:"")_"including TRANSFER DRGs"
- +2 SET DGTCH="DRG FREQUENCY by "_P3_"^"_P3_"^PAGE #"
- DO C^DGUTL
- QUIT
- FD FOR I=0:0
- SET I=$ORDER(^UTILITY($JOB,"DGPTFR","D",I))
- IF I'>0
- QUIT
- SET J=^(I)
- SET S=$SELECT($DATA(^(I,"AT")):$PIECE(^("AT"),U,3),1:0)
- DO FD1
- +1 IF "SB"[DGS
- IF $DATA(^UTILITY($JOB,"DGPTFR","SB"))
- SET I=0
- FOR I1=0:0
- SET I=$ORDER(^UTILITY($JOB,"DGPTFR","SB",I))
- IF I']""
- QUIT
- SET S=^(I)
- FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"DGPTFR","SB",I,J))
- IF J'>0
- QUIT
- SET B=^(J)
- DO E1
- +2 QUIT
- E1 FOR D=0:0
- SET D=$ORDER(^UTILITY($JOB,"DGPTFR","SB",I,J,D))
- IF D'>0
- QUIT
- SET D1=^(D)
- SET T=$SELECT($DATA(^(D,"AT")):$PIECE(^("AT"),U,3),1:0)
- SET T1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","SB",I,J,D,"BT")):$PIECE(^("BT"),U,4,5)_U_$PIECE(^("BT"),U,2),1:0_U_0)
- SET ^UTILITY($JOB,"DGPTFR","FS",I)=S
- DO E2
- +1 QUIT
- E2 SET $PIECE(^(D),U)=+D1+$SELECT($DATA(^UTILITY($JOB,"DGPTFR","FS",I,D)):$PIECE(^(D),U),1:0)
- SET $PIECE(^(D),U,2)=$PIECE(^(D),U,2)+$PIECE(D1,U,2)
- SET $PIECE(^(D),U,3,8)=$PIECE(D1,U,3,8)
- SET $PIECE(^(D),U,9)=$PIECE(^(D),U,9)+T
- SET $PIECE(^(D),U,10)=+T1+$PIECE(^(D),U,10)
- SET $PIECE(^(D),U,11)=$PIECE(^(D),U,11)+$PIECE(T1,U,2)
- +1 SET $PIECE(^(D),U,12)=$PIECE(^UTILITY($JOB,"DGPTFR","FS",I,D),U,12)+$PIECE(T1,U,3)
- SET ^UTILITY($JOB,"DGPTFR","FB",I)=S
- SET ^(I,J)=B
- SET ^(J,(999999-$PIECE(D1,U,2)),D)=D1_U_T_U_T1
- QUIT
- FD1 SET S1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","D",I,"BT")):$PIECE(^("BT"),U,4,5),1:0_U_0)
- SET $PIECE(S1,U,3)=$SELECT($DATA(^("BT")):$PIECE(^("BT"),U,2),1:0)+$PIECE(S1,U,3)
- SET ^UTILITY($JOB,"DGPTFR","FD",(999999-$PIECE(J,U,2)),I)=J_U_S_U_S1
- QUIT
