- 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 Feb 19, 2025@00:19:15 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