source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTOD0.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1DGPTOD0 ;ALB/AS - PTF DRG REPORTS ; 9/5/01 11:38am
2 ;;5.3;Registration;**158,164,238,375**;Aug 13, 1993
3 W !!,*7,"THIS REPORT REQUIRES 132 COLUMN OUTPUT."
4 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
5Q 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
6RD S X="" R X:DTIME I X["^"!('$T) S DGQ=1 Q
7 S X=$E(X) Q
8ASK 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
9 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
10 S DGD=$S(X="D":1,1:0) I 'DGD S DGSD=0,DGED=(DT_.9),DGCR="AADA",DGB=1 G SVC
11DC 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
12 I Y<3001001 W *7,!?12,"Discharge dates may not begin prior to October 1,2000" G DC
13 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
14 S DGED=Y_.9
15 ; check that range does not overlap fiscal years
16 I $$FY(DGSD)'=$$FY(DGED) W *7,!?12,"Please do not select dates that overlap fiscal years" G DC
17DRG 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
18 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
19 S DGB=$S(X="T":1,1:0)
20SVC I DGPTFR="*4" S X="M" G CONT ;no choice for Case Mix Report
21 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^"
22 D RD Q:DGQ I X="" S X="B" W X
23 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
24CONT 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:"")
25 ;I '$D(^ICD("AFY",DGFY2K))!(DGCST']"") D NOFY G ASK
26 ;I $P(DGCST,"^",2)'>0!($P(DGCST,"^",3)'>0)!($P(DGCST,"^",5)'>0) D NOFY G ASK
27 W !!,"You have selected output for: ",!?4,$S(DGD:"Patients discharged between ",1:"Active admissions")
28 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."
29 I DGPTFR="*4" G OK1
30 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"),"."
31OK1 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
32 S:%'=1 DGQ=1 Q
33 Q
34NOFY ; this no longer applies
35 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"
36 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."
37 Q
38DGY2K(X) ; convert date to fm
39 N %DT,Y
40 D ^%DT
41 Q Y
42 ;
43FY(X) ;Return FY
44 ;Input: X=date
45 S:$E(X,4,5)>9 X=$E(X,1,3)+1
46 Q (17+$E(X))_$E(X,2,3)
Note: See TracBrowser for help on using the repository browser.