DGPTOD0.m

DGPTOD0 ;ALB/AS - PTF DRG REPORTS  ; 9/5/01 11:38am

 ;;5.3;Registration;**158,164,238,375,1015**;Aug 13, 1993;Build 21

 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)

DGPTOD0   ;ALB/AS - PTF DRG REPORTS  ; 9/5/01 11:38am

 +1       ;;5.3;Registration;**158,164,238,375,1015**;Aug 13, 1993;Build 21

 +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)