| 1 | DGPTBE1 ;ALB/BOK - ENTER BREAKEVEN VALUES FOR DRG ; 27 APR 88 @ 0900
|
|---|
| 2 | ;;5.3;Registration;**158,252**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | FY 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
|
|---|
| 9 | QRTR 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)
|
|---|
| 16 | SV 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"
|
|---|
| 19 | BE 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
|
|---|
| 22 | CONTINU F DGGO=0:0 S %=1 W !!,"Do you wish to select another DRG" D YN^DICN G:%=0 HELP1 Q:%'=1 D DRG
|
|---|
| 23 | Q K DIC,DGBE,DGCURENT,DGFY,DGFY1,DGGO,DGHD,DGQRTR,DGS,DGSV,DGVALUES,DGY,DRG,%,I,X,Y,Z Q
|
|---|
| 24 | W 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
|
|---|
| 25 | TABLE 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
|
|---|
| 28 | DRG 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)
|
|---|
| 35 | C 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
|
|---|
| 37 | DGBE 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
|
|---|
| 39 | HELP 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
|
|---|
| 40 | HELP1 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
|
|---|
