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

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1DGPTBE1 ;ALB/BOK - ENTER BREAKEVEN VALUES FOR DRG ; 27 APR 88 @ 0900
2 ;;5.3;Registration;**158,252**;Aug 13, 1993
3 ;
4FY W !!,"Enter Values for (F)ISCAL YEAR or (Q)UARTER: QUARTER// " S Z="^QUARTER^FISCAL YEAR" S X="" R X:DTIME G Q:X["^"!('$T) I X="" S X="Q" W X
5 D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM: ",!?12,"Q - values are entered on a quarterly basis",!?12,"F - values are entered once a year and are ",!?16,"therefore the same for each quarter." S %="" G FY
6 S DGY=$S(X="Q":1,1:0)
7 ;Display help text
8 D HELP
9QRTR W !!,"Select Fiscal Year",$S(DGY:" and Quarter: ",1:": ") R DGFY:DTIME G Q:DGFY["^"!('$T)!(DGFY="") I DGY,($L(DGFY)'=5)!("1234"'[($E(DGFY,5)))!(DGFY<19801) D HELP G QRTR
10 I 'DGY I $L(DGFY)'=4!(DGFY<1980) D HELP G QRTR
11 ;Validate year entered
12 N DGFY2B
13 S DGFY2B=$$DGY2K^DGPTOD0($E(DGFY,1,4))
14 I DGFY2B<0 D HELP G QRTR
15 S DGFY2B=$$FMTE^XLFDT(DGFY2B),DGFY=DGFY2B_$E(DGFY,5)
16SV W !!,"Enter values by (I)NDIVIDUAL SERVICE or ",!?3,"(S)AME VALUE FOR ALL SERVICES: INDIVIDUAL// " S Z="^INDIVIDUAL SERVICE^SAME VALUE FOR ALL SERVICES" S X="" R X:DTIME G Q:X["^"!('$T) I X="" S X="I" W X
17 D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM: ",!?12,"I - values are entered for each service",!?12,"S - one value is entered and used for all services" G SV
18 S DGS=$S(X="I":1,1:0),DGHD="FY MED NEUR PSYCH REHAB SURG MED CTR"
19BE S DGVALUES="" I 'DGS W !!,"MEDICAL CENTER BREAKEVEN DAYS: " D DGBE Q:'DGGO F %=1:1:6 S DGVALUES=DGVALUES_DGBE_"^"
20 I DGS W ! F DGSV=1:1:6 D W,DGBE Q:'DGGO S DGVALUES=DGVALUES_DGBE_"^"
21 G Q:'DGGO D TABLE,DRG
22CONTINU F DGGO=0:0 S %=1 W !!,"Do you wish to select another DRG" D YN^DICN G:%=0 HELP1 Q:%'=1 D DRG
23Q K DIC,DGBE,DGCURENT,DGFY,DGFY1,DGGO,DGHD,DGQRTR,DGS,DGSV,DGVALUES,DGY,DRG,%,I,X,Y,Z Q
24W W !,$S(DGSV=1:"MEDICINE",DGSV=2:"NEUROLOGY",DGSV=3:"PSYCHIATRY",DGSV=4:"REHAB MEDICINE",DGSV=5:"SURGERY",1:"MEDICAL CENTER"),$S(DGSV'=6:" SERVICE",1:"")," BREAKEVEN DAYS: " Q
25TABLE W !!,$J("TABLE OF BREAKEVEN VALUES YOU HAVE SELECTED:",55),!,DGHD,! F %=1:1:7 W "------- "
26 W !,DGFY,?7 F %=1:1:6 W ?3,$J($P(DGVALUES,"^",%),10)
27 W ! Q
28DRG K DGCURENT S DGCURENT="",DIC("A")="MOVE BREAKEVEN VALUES FROM TABLE INTO WHICH DRG? ",DIC(0)="AEQM",DIC="^ICD(" D ^DIC Q:Y'>0 S DRG=+Y K DIC
29 S:'$D(^ICD(DRG,"BE",0)) ^(0)="^80.23" F %=1:1:4 S DGFY1=$S(DGY:DGFY,1:DGFY_%) S:'$D(^ICD(DRG,"BE",DGFY1,"S",0)) ^(0)="^80.24SA" Q:DGY
30 I DGY S:$D(^ICD(DRG,"BE",DGFY,0))#2 $P(DGCURENT(1),"^",6)=$P(^ICD(DRG,"BE",DGFY,0),"^",2) F %=1:1:5 S:$D(^ICD(DRG,"BE",DGFY,"S",%,0)) $P(DGCURENT(1),"^",%)=$P(^ICD(DRG,"BE",DGFY,"S",%,0),"^",2)
31 I 'DGY F %=1:1:4 S:$D(^ICD(DRG,"BE",DGFY_%,0))#2 $P(DGCURENT(%),"^",6)=$P(^ICD(DRG,"BE",DGFY_%,0),"^",2) F I=1:1:5 S:$D(^ICD(DRG,"BE",DGFY_%,"S",I,0)) $P(DGCURENT(%),"^",I)=$P(^ICD(DRG,"BE",DGFY_%,"S",I,0),"^",2)
32 F %=0:0 S %=$O(DGCURENT(%)) Q:%'>0 I DGCURENT(%)]"" S DGCURENT=1 Q
33 W !!,$S(DGCURENT:" ",1:"NO")," BREAKEVEN VALUES CURRENTLY IN FILE FOR DRG: ",DRG,$S(DGCURENT:"",'DGY:" for selected FY",1:" for selected FY/Q") I DGCURENT W !,DGHD,! F %=1:1:7 W "------- "
34 I DGCURENT F I=0:0 S I=$O(DGCURENT(I)) Q:I'>0 W !,DGFY,$S(DGY:"",1:I),?7 F %=1:1:6 W ?3,$J($P(DGCURENT(I),"^",%),10)
35C W !!,"COPY VALUES FROM TABLE INTO DRG FILE" S %=1 D YN^DICN Q:%=2 I %=0 W !!?12,"Y - to have your selected breakeven values",!?16,"copied into the DRG File",!?12,"N - to make no changes to the DRG File" G C
36 Q:%'=1 S DGBE=$P(DGVALUES,"^",6) D WAIT^DICD,^DGPTBE2 Q
37DGBE S DGGO="" R DGBE:DTIME Q:DGBE["^"!('$T) I +DGBE'=DGBE!(DGBE>366)!(DGBE<0)!($L($P(DGBE,".",2))>1) W !,"enter a number between 0 and 366, up to 1 decimal digit" W !,"BREAKEVEN DAYS: " G DGBE
38 S DGGO=1 Q
39HELP W !!?5,"Please enter a 4-digit fiscal year",$S(DGY:" and quarter",1:"")," as 1999",$S(DGY:"1",1:"")," for fiscal",!?5,"year 1999",$S(DGY:" first quarter",1:""),". Fiscal years earlier than 1980 not allowed." Q
40HELP1 W !!?12,"CHOOSE FROM: ",!?12,"Y - yes to copy the same breakeven values from the table",!?16,"into a different DRG",!?12,"N - no to exit" G CONTINU
Note: See TracBrowser for help on using the repository browser.