DGPTODF2 ;ALB/MTC - PTF DRG FREQUENCY REPORT,CONT. ; 9/14/01 4:34pm
;;5.3;Registration;**375**;Aug 13, 1993
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTODF2 2299 printed Dec 13, 2024@02:53:06 Page 2
DGPTODF2 ;ALB/MTC - PTF DRG FREQUENCY REPORT,CONT. ; 9/14/01 4:34pm
+1 ;;5.3;Registration;**375**;Aug 13, 1993
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
