DGPTOD0 ;ALB/AS - PTF DRG REPORTS ; 9/5/01 11:38am
;;5.3;Registration;**158,164,238,375**;Aug 13, 1993
W !!,*7,"THIS REPORT REQUIRES 132 COLUMN OUTPUT."
D LO^DGUTL,Q,ASK G Q:DGQ S DGPGM="^DGPTOD1",DGVAR="DGSD^DGED^DGCR^DGB^DGS^DGD^DUZ^DGPTFR^DGCST" D ZIS^DGUTQ G:POP Q U IO S X=132 X ^%ZOSF("RM") D ^DGPTOD1,CLOSE^DGUTQ K DGPTFR
Q K ^UTILITY($J),X,Y,Z,DG1,DG2,DG3,DG4,DGD,DGSD,DGED,DGCR,DGS,DGB,DGQ,DG1DAWW,DGHIWW,DGWWCST,DGCST,DGFY,DGFT,DGFY2K,DGSDFY Q
RD S X="" R X:DTIME I X["^"!('$T) S DGQ=1 Q
S X=$E(X) Q
ASK S DGQ="" W !!,"For (A)CTIVE ADMISSIONS or",!?4,"(D)ISCHARGED PATIENTS: DISCHARGED// " S Z="^ACTIVE ADMISSIONS^DISCHARGED PATIENTS" D RD Q:DGQ I X="" S X="D" W X
D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"A - Active Admissions (all current inpatients)",!?12,"D - Discharged Patients within a date range",! S %="" G ASK
S DGD=$S(X="D":1,1:0) I 'DGD S DGSD=0,DGED=(DT_.9),DGCR="AADA",DGB=1 G SVC
DC W ! S DGCR="ADS",%DT="AEXP",%DT(0)=-DT S %DT("A")="Start with DISCHARGE DATE: " D ^%DT S:X["^" DGQ=1 Q:DGQ G:Y<0 DC S DGSD=Y-.1
I Y<3001001 W *7,!?12,"Discharge dates may not begin prior to October 1,2000" G DC
S %DT("A")=" End with DISCHARGE DATE: ",%DT="AEXP",%DT(0)=DGSD D ^%DT S:X["^" DGQ=1 Q:DGQ G:Y<0 DC I (DGSD+10000)<Y W *7,!?12,"Please limit your date range to no more than 1 year" G DC
S DGED=Y_.9
; check that range does not overlap fiscal years
I $$FY(DGSD)'=$$FY(DGED) W *7,!?12,"Please do not select dates that overlap fiscal years" G DC
DRG W !!,"For (T)RANSFER DRGs or",!?4,"(D)RG from 701/702/703 TRANSACTIONS: TRANSFER DRGs// " S Z="^TRANSFER DRGs^DRGs from 701/702/703 TRANSACTIONS" D RD Q:DGQ I X="" S X="T" W X
D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"D - to include DRGs calculated using diagnosis codes from",!?16,"701/702/703 transactions",!?12,"T - to include TRANSFER DRGs based on diagnosis codes from",!?16,"501 transactions",! S %="" G DRG
S DGB=$S(X="T":1,1:0)
SVC I DGPTFR="*4" S X="M" G CONT ;no choice for Case Mix Report
W !!,"Sort Report by DRG for:",!?3,"(M)EDICAL CENTER ONLY or",!?3,"(S)ERVICE WITH SPECIALTY BREAKOUT or",!?3,"(B)OTH MEDICAL CENTER AND SERVICE WITH SPECIALTY: BOTH// " S Z="^MEDICAL CENTER ONLY^SERVICE WITH SPECIALTY^BOTH^"
D RD Q:DGQ I X="" S X="B" W X
D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"M - to have report sorted by DRG for entire medical center or",!?12,"S - for service with specialties or",!?12,"B - for both medical center and service with specialties",! S %="" G SVC
CONT S DGS=$S(X="B":"B",X="M":"D",1:"S"),DGFY=$$FY(DGED),DGFY2K=$$DGY2K(DGFY),DGCST=$S($D(^DG(43,1,"FY",DGFY2K)):^(DGFY2K,0),1:"")
;I '$D(^ICD("AFY",DGFY2K))!(DGCST']"") D NOFY G ASK
;I $P(DGCST,"^",2)'>0!($P(DGCST,"^",3)'>0)!($P(DGCST,"^",5)'>0) D NOFY G ASK
W !!,"You have selected output for: ",!?4,$S(DGD:"Patients discharged between ",1:"Active admissions")
I DGD S Y=(DGSD+.1) X ^DD("DD") W ?4,Y," and " S Y=$P(DGED,".") X ^DD("DD") W Y,!?4,$S('DGB:"not ",1:""),"including TRANSFER DRGs."
I DGPTFR="*4" G OK1
W !?4,"With breakout by ",$S(DGS="B":"Both Medical Center and Service with Specialties",DGS="D":"Medical Center Only",1:"Service with Specialties Only"),"."
OK1 W !,"IS THIS CORRECT" S %=1 D YN^DICN I '% W !!,"Enter <RET> if this information is correct",!?10,"Enter 'N' for N0 to exit",!! G OK1
S:%'=1 DGQ=1 Q
Q
NOFY ; this no longer applies
W !!,*7,"RAM COSTS and/or DRG WEIGHTS/TRIMS are not entered for Fiscal Year ",DGFY,".",!,"PROCESSING CAN NOT BE DONE FOR SELECTED TIME FRAME"
W !,"The following RAM values must be entered in your MAS PARAMETERS File",!,"for whatever fiscal year you select: $ PER WWU; COST FOR 1 DAY LOS;",!,"HIGH OUTLIER COST PER DAY.",!,"DRG fy weights and trims must be entered in your DRG File."
Q
DGY2K(X) ; convert date to fm
N %DT,Y
D ^%DT
Q Y
;
FY(X) ;Return FY
;Input: X=date
S:$E(X,4,5)>9 X=$E(X,1,3)+1
Q (17+$E(X))_$E(X,2,3)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTOD0 3931 printed Dec 13, 2024@02:52:57 Page 2
DGPTOD0 ;ALB/AS - PTF DRG REPORTS ; 9/5/01 11:38am
+1 ;;5.3;Registration;**158,164,238,375**;Aug 13, 1993
+2 WRITE !!,*7,"THIS REPORT REQUIRES 132 COLUMN OUTPUT."
+3 DO LO^DGUTL
DO Q
DO ASK
if DGQ
GOTO Q
SET DGPGM="^DGPTOD1"
SET DGVAR="DGSD^DGED^DGCR^DGB^DGS^DGD^DUZ^DGPTFR^DGCST"
DO ZIS^DGUTQ
if POP
GOTO Q
USE IO
SET X=132
XECUTE ^%ZOSF("RM")
DO ^DGPTOD1
DO CLOSE^DGUTQ
KILL DGPTFR
Q KILL ^UTILITY($JOB),X,Y,Z,DG1,DG2,DG3,DG4,DGD,DGSD,DGED,DGCR,DGS,DGB,DGQ,DG1DAWW,DGHIWW,DGWWCST,DGCST,DGFY,DGFT,DGFY2K,DGSDFY
QUIT
RD SET X=""
READ X:DTIME
IF X["^"!('$TEST)
SET DGQ=1
QUIT
+1 SET X=$EXTRACT(X)
QUIT
ASK SET DGQ=""
WRITE !!,"For (A)CTIVE ADMISSIONS or",!?4,"(D)ISCHARGED PATIENTS: DISCHARGED// "
SET Z="^ACTIVE ADMISSIONS^DISCHARGED PATIENTS"
DO RD
if DGQ
QUIT
IF X=""
SET X="D"
WRITE X
+1 DO IN^DGHELP
IF %=-1
WRITE !!?12,"CHOOSE FROM:",!?12,"A - Active Admissions (all current inpatients)",!?12,"D - Discharged Patients within a date range",!
SET %=""
GOTO ASK
+2 SET DGD=$SELECT(X="D":1,1:0)
IF 'DGD
SET DGSD=0
SET DGED=(DT_.9)
SET DGCR="AADA"
SET DGB=1
GOTO SVC
DC WRITE !
SET DGCR="ADS"
SET %DT="AEXP"
SET %DT(0)=-DT
SET %DT("A")="Start with DISCHARGE DATE: "
DO ^%DT
if X["^"
SET DGQ=1
if DGQ
QUIT
if Y<0
GOTO DC
SET DGSD=Y-.1
+1 IF Y<3001001
WRITE *7,!?12,"Discharge dates may not begin prior to October 1,2000"
GOTO DC
+2 SET %DT("A")=" End with DISCHARGE DATE: "
SET %DT="AEXP"
SET %DT(0)=DGSD
DO ^%DT
if X["^"
SET DGQ=1
if DGQ
QUIT
if Y<0
GOTO DC
IF (DGSD+10000)<Y
WRITE *7,!?12,"Please limit your date range to no more than 1 year"
GOTO DC
+3 SET DGED=Y_.9
+4 ; check that range does not overlap fiscal years
+5 IF $$FY(DGSD)'=$$FY(DGED)
WRITE *7,!?12,"Please do not select dates that overlap fiscal years"
GOTO DC
DRG WRITE !!,"For (T)RANSFER DRGs or",!?4,"(D)RG from 701/702/703 TRANSACTIONS: TRANSFER DRGs// "
SET Z="^TRANSFER DRGs^DRGs from 701/702/703 TRANSACTIONS"
DO RD
if DGQ
QUIT
IF X=""
SET X="T"
WRITE X
+1 DO IN^DGHELP
IF %=-1
WRITE !!?12,"CHOOSE FROM:",!?12,"D - to include DRGs calculated using diagnosis codes from",!?16,"701/702/703 transactions",!?12,"T - to include TRANSFER DRGs based on diagnosis codes from",!?16,"501 transactions",!
SET %=""
GOTO DRG
+2 SET DGB=$SELECT(X="T":1,1:0)
SVC ;no choice for Case Mix Report
IF DGPTFR="*4"
SET X="M"
GOTO CONT
+1 WRITE !!,"Sort Report by DRG for:",!?3,"(M)EDICAL CENTER ONLY or",!?3,"(S)ERVICE WITH SPECIALTY BREAKOUT or",!?3,"(B)OTH MEDICAL CENTER AND SERVICE WITH SPECIALTY: BOTH// "
SET Z="^MEDICAL CENTER ONLY^SERVICE WITH SPECIALTY^BOTH^"
+2 DO RD
if DGQ
QUIT
IF X=""
SET X="B"
WRITE X
+3 DO IN^DGHELP
IF %=-1
WRITE !!?12,"CHOOSE FROM:",!?12,"M - to have report sorted by DRG for entire medical center or",!?12,"S - for service with specialties or",!?12,"B - for both medical center and service with specialties",!
SET %=""
GOTO SVC
CONT SET DGS=$SELECT(X="B":"B",X="M":"D",1:"S")
SET DGFY=$$FY(DGED)
SET DGFY2K=$$DGY2K(DGFY)
SET DGCST=$SELECT($DATA(^DG(43,1,"FY",DGFY2K)):^(DGFY2K,0),1:"")
+1 ;I '$D(^ICD("AFY",DGFY2K))!(DGCST']"") D NOFY G ASK
+2 ;I $P(DGCST,"^",2)'>0!($P(DGCST,"^",3)'>0)!($P(DGCST,"^",5)'>0) D NOFY G ASK
+3 WRITE !!,"You have selected output for: ",!?4,$SELECT(DGD:"Patients discharged between ",1:"Active admissions")
+4 IF DGD
SET Y=(DGSD+.1)
XECUTE ^DD("DD")
WRITE ?4,Y," and "
SET Y=$PIECE(DGED,".")
XECUTE ^DD("DD")
WRITE Y,!?4,$SELECT('DGB:"not ",1:""),"including TRANSFER DRGs."
+5 IF DGPTFR="*4"
GOTO OK1
+6 WRITE !?4,"With breakout by ",$SELECT(DGS="B":"Both Medical Center and Service with Specialties",DGS="D":"Medical Center Only",1:"Service with Specialties Only"),"."
OK1 WRITE !,"IS THIS CORRECT"
SET %=1
DO YN^DICN
IF '%
WRITE !!,"Enter <RET> if this information is correct",!?10,"Enter 'N' for N0 to exit",!!
GOTO OK1
+1 if %'=1
SET DGQ=1
QUIT
+2 QUIT
NOFY ; this no longer applies
+1 WRITE !!,*7,"RAM COSTS and/or DRG WEIGHTS/TRIMS are not entered for Fiscal Year ",DGFY,".",!,"PROCESSING CAN NOT BE DONE FOR SELECTED TIME FRAME"
+2 WRITE !,"The following RAM values must be entered in your MAS PARAMETERS File",!,"for whatever fiscal year you select: $ PER WWU; COST FOR 1 DAY LOS;",!,"HIGH OUTLIER COST PER DAY.",!,"DRG fy weights and trims must be entered in your DRG File."
+3 QUIT
DGY2K(X) ; convert date to fm
+1 NEW %DT,Y
+2 DO ^%DT
+3 QUIT Y
+4 ;
FY(X) ;Return FY
+1 ;Input: X=date
+2 if $EXTRACT(X,4,5)>9
SET X=$EXTRACT(X,1,3)+1
+3 QUIT (17+$EXTRACT(X))_$EXTRACT(X,2,3)
