DGPTODT2 ;ALB/BOK - PTF DRG TRIM POINT REPORT CONT ; 9/7/01 11:33am
;;5.3;Registration;**375**;Aug 13, 1993
MTRIM K DGBT1,DGWT1,DGBT1 S DGBT1=$S($D(^UTILITY($J,"DGPTFR","D",D2,"BT")):^("BT"),1:0),B1=+DGBT1+B1,B5=$P(DGBT1,U,5)+B5,B4=B4+$P(DGBT1,U,4),B2=B2+$P(DGBT1,U,2)
S DGWT1=$S($D(^UTILITY($J,"DGPTFR","D",D2,"WT")):^("WT"),1:0_U_0),W1=+DGWT1+W1,W2=$P(DGWT1,U,2)+W2
S DGAT1=$S($D(^UTILITY($J,"DGPTFR","D",D2,"AT")):^("AT"),1:0),A1=$P(DGAT1,U,3)+A1,A2=$P(DGAT1,U,2)+A2,A3=+DGAT1+A3
S:'$D(^UTILITY($J,"DGTC",D2)) ^(D2,P)=""
Q
TSET S $P(^UTILITY($J,"DGPTFR","T",D2),U,1)=$S($D(^UTILITY($J,"DGPTFR","T",D2)):+^(D2),1:0)+(+D3),$P(^UTILITY($J,"DGPTFR","T",D2),U,3)=$P(^UTILITY($J,"DGPTFR","T",D2),U,3)+$P(D3,U,2)
BSTRIM S ^UTILITY($J,"DGTC",P1,P)="" K DGBT1,DGWT1,DGAT1 S DGBT1=$S($D(^UTILITY($J,"DGPTFR","SB",G,D,D2,"BT")):^("BT"),1:0),B1=+DGBT1+B1,B5=B5+$P(DGBT1,U,5),B4=B4+$P(DGBT1,U,4),B2=B2+$P(DGBT1,U,2)
S DGWT1=$S($D(^UTILITY($J,"DGPTFR","SB",G,D,D2,"WT")):^("WT"),1:0),W1=+DGWT1+W1,W2=$P(DGWT1,U,2)+W2
S DGAT1=$S($D(^UTILITY($J,"DGPTFR","SB",G,D,D2,"AT")):^("AT"),1:0),A1=$P(DGAT1,U,3)+A1,A2=$P(DGAT1,U,2)+A2,A3=+DGAT1+A3 G:DGFLAG["Serv" STRIM
Q
STRIM S Z=^UTILITY($J,"DGPTFR","T",D2),$P(^UTILITY($J,"DGPTFR","T",D2),U,6)=+DGBT1+$P(Z,U,6),$P(^UTILITY($J,"DGPTFR","T",D2),U,7)=$P(Z,U,7)+$P(DGBT1,U,2)
S $P(^UTILITY($J,"DGPTFR","T",D2),U,8)=+DGWT1+$P(Z,U,8),$P(^UTILITY($J,"DGPTFR","T",D2),U,9)=$P(Z,U,9)+$P(DGWT1,U,2)
S $P(^UTILITY($J,"DGPTFR","T",D2),U,10)=+DGAT1+$P(Z,U,10),$P(^UTILITY($J,"DGPTFR","T",D2),U,11)=$P(Z,U,11)+$P(DGAT1,U,2),$P(^UTILITY($J,"DGPTFR","T",D2),U,12)=$P(Z,U,12)+$P(DGAT1,U,3)
S $P(^UTILITY($J,"DGPTFR","T",D2),U,2)=$P(Z,U,2)+$P(DGBT1,U,4) Q
HEAD I P S %=IOSL-14 F E=$Y:1:% W !
I P D DIS^DGPTOD1 W !!
W:P ?62,"-",P,"-" W @IOF,!,"DRG Trim Point Totals for ",$S(DGFLAG'["M":G2_" SERVICE",1:"MEDICAL CENTER"),$S(DGFLAG["Spec":" by Specialty",1:"") I 'DGD W " for Active Admissions"
I DGD W !,"Discharge Dates from " 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:"not ",1:""),"including TRANSFER DRGs"
W !!?38,"| BELOW | WITHIN TRIM | ABOVE TRIM |",!?16,"National",?30," ",?38,"|-------|----------------|------------------------|"
W !,H,?36," | # of | # of",?57,"Total | # of",?71,"Days Above ",?82,"Total |",?91,"Total Total Total",?123,"Average",!,H1
W "| Disch | Disch LOS | Disch Trim",?83,"LOS | Disch LOS",?109,"Weight(*)",?124,"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)="TRIM POINT Report for "_DGFLAG_" by DRG",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="TRIM POINT by DRG^"_P3_"^PAGE #" D C^DGUTL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTODT2 2954 printed Apr 09, 2024@21:46:30 Page 2
DGPTODT2 ;ALB/BOK - PTF DRG TRIM POINT REPORT CONT ; 9/7/01 11:33am
+1 ;;5.3;Registration;**375**;Aug 13, 1993
MTRIM KILL DGBT1,DGWT1,DGBT1
SET DGBT1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","D",D2,"BT")):^("BT"),1:0)
SET B1=+DGBT1+B1
SET B5=$PIECE(DGBT1,U,5)+B5
SET B4=B4+$PIECE(DGBT1,U,4)
SET B2=B2+$PIECE(DGBT1,U,2)
+1 SET DGWT1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","D",D2,"WT")):^("WT"),1:0_U_0)
SET W1=+DGWT1+W1
SET W2=$PIECE(DGWT1,U,2)+W2
+2 SET DGAT1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","D",D2,"AT")):^("AT"),1:0)
SET A1=$PIECE(DGAT1,U,3)+A1
SET A2=$PIECE(DGAT1,U,2)+A2
SET A3=+DGAT1+A3
+3 if '$DATA(^UTILITY($JOB,"DGTC",D2))
SET ^(D2,P)=""
+4 QUIT
TSET SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,1)=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","T",D2)):+^(D2),1:0)+(+D3)
SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,3)=$PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,3)+$PIECE(D3,U,2)
BSTRIM SET ^UTILITY($JOB,"DGTC",P1,P)=""
KILL DGBT1,DGWT1,DGAT1
SET DGBT1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","SB",G,D,D2,"BT")):^("BT"),1:0)
SET B1=+DGBT1+B1
SET B5=B5+$PIECE(DGBT1,U,5)
SET B4=B4+$PIECE(DGBT1,U,4)
SET B2=B2+$PIECE(DGBT1,U,2)
+1 SET DGWT1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","SB",G,D,D2,"WT")):^("WT"),1:0)
SET W1=+DGWT1+W1
SET W2=$PIECE(DGWT1,U,2)+W2
+2 SET DGAT1=$SELECT($DATA(^UTILITY($JOB,"DGPTFR","SB",G,D,D2,"AT")):^("AT"),1:0)
SET A1=$PIECE(DGAT1,U,3)+A1
SET A2=$PIECE(DGAT1,U,2)+A2
SET A3=+DGAT1+A3
if DGFLAG["Serv"
GOTO STRIM
+3 QUIT
STRIM SET Z=^UTILITY($JOB,"DGPTFR","T",D2)
SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,6)=+DGBT1+$PIECE(Z,U,6)
SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,7)=$PIECE(Z,U,7)+$PIECE(DGBT1,U,2)
+1 SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,8)=+DGWT1+$PIECE(Z,U,8)
SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,9)=$PIECE(Z,U,9)+$PIECE(DGWT1,U,2)
+2 SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,10)=+DGAT1+$PIECE(Z,U,10)
SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,11)=$PIECE(Z,U,11)+$PIECE(DGAT1,U,2)
SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,12)=$PIECE(Z,U,12)+$PIECE(DGAT1,U,3)
+3 SET $PIECE(^UTILITY($JOB,"DGPTFR","T",D2),U,2)=$PIECE(Z,U,2)+$PIECE(DGBT1,U,4)
QUIT
HEAD 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,!,"DRG Trim Point Totals 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 !,"Discharge Dates from "
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:"not ",1:""),"including TRANSFER DRGs"
+5 WRITE !!?38,"| BELOW | WITHIN TRIM | ABOVE TRIM |",!?16,"National",?30," ",?38,"|-------|----------------|------------------------|"
+6 WRITE !,H,?36," | # of | # of",?57,"Total | # of",?71,"Days Above ",?82,"Total |",?91,"Total Total Total",?123,"Average",!,H1
+7 WRITE "| Disch | Disch LOS | Disch Trim",?83,"LOS | Disch LOS",?109,"Weight(*)",?124,"Weight",!
+8 KILL E
SET $PIECE(E,"=",133)=""
WRITE E
KILL E
+9 SET P=P+1
QUIT
COV KILL ^UTILITY($JOB,"DGTC"),DGCPG,DGTCH
SET DGCPG(1)="TRIM POINT Report for "_DGFLAG_" by DRG"
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="TRIM POINT by DRG^"_P3_"^PAGE #"
DO C^DGUTL
QUIT
