- DGPTBE1 ;ALB/BOK - ENTER BREAKEVEN VALUES FOR DRG ; 27 APR 88 @ 0900
- ;;5.3;Registration;**158,252**;Aug 13, 1993
- ;
- 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
- 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
- S DGY=$S(X="Q":1,1:0)
- ;Display help text
- D HELP
- 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
- I 'DGY I $L(DGFY)'=4!(DGFY<1980) D HELP G QRTR
- ;Validate year entered
- N DGFY2B
- S DGFY2B=$$DGY2K^DGPTOD0($E(DGFY,1,4))
- I DGFY2B<0 D HELP G QRTR
- S DGFY2B=$$FMTE^XLFDT(DGFY2B),DGFY=DGFY2B_$E(DGFY,5)
- 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
- 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
- S DGS=$S(X="I":1,1:0),DGHD="FY MED NEUR PSYCH REHAB SURG MED CTR"
- BE S DGVALUES="" I 'DGS W !!,"MEDICAL CENTER BREAKEVEN DAYS: " D DGBE Q:'DGGO F %=1:1:6 S DGVALUES=DGVALUES_DGBE_"^"
- I DGS W ! F DGSV=1:1:6 D W,DGBE Q:'DGGO S DGVALUES=DGVALUES_DGBE_"^"
- G Q:'DGGO D TABLE,DRG
- 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
- Q K DIC,DGBE,DGCURENT,DGFY,DGFY1,DGGO,DGHD,DGQRTR,DGS,DGSV,DGVALUES,DGY,DRG,%,I,X,Y,Z Q
- 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
- TABLE W !!,$J("TABLE OF BREAKEVEN VALUES YOU HAVE SELECTED:",55),!,DGHD,! F %=1:1:7 W "------- "
- W !,DGFY,?7 F %=1:1:6 W ?3,$J($P(DGVALUES,"^",%),10)
- W ! Q
- 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
- 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
- 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)
- 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)
- F %=0:0 S %=$O(DGCURENT(%)) Q:%'>0 I DGCURENT(%)]"" S DGCURENT=1 Q
- 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 "------- "
- 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)
- 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
- Q:%'=1 S DGBE=$P(DGVALUES,"^",6) D WAIT^DICD,^DGPTBE2 Q
- 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
- S DGGO=1 Q
- 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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTBE1 4048 printed Mar 13, 2025@21:56:28 Page 2
- DGPTBE1 ;ALB/BOK - ENTER BREAKEVEN VALUES FOR DRG ; 27 APR 88 @ 0900
- +1 ;;5.3;Registration;**158,252**;Aug 13, 1993
- +2 ;
- FY WRITE !!,"Enter Values for (F)ISCAL YEAR or (Q)UARTER: QUARTER// "
- SET Z="^QUARTER^FISCAL YEAR"
- SET X=""
- READ X:DTIME
- if X["^"!('$TEST)
- GOTO Q
- IF X=""
- SET X="Q"
- WRITE X
- +1 DO IN^DGHELP
- IF %=-1
- WRITE !!?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."
- SET %=""
- GOTO FY
- +2 SET DGY=$SELECT(X="Q":1,1:0)
- +3 ;Display help text
- +4 DO HELP
- QRTR WRITE !!,"Select Fiscal Year",$SELECT(DGY:" and Quarter: ",1:": ")
- READ DGFY:DTIME
- if DGFY["^"!('$TEST)!(DGFY="")
- GOTO Q
- IF DGY
- IF ($LENGTH(DGFY)'=5)!("1234"'[($EXTRACT(DGFY,5)))!(DGFY<19801)
- DO HELP
- GOTO QRTR
- +1 IF 'DGY
- IF $LENGTH(DGFY)'=4!(DGFY<1980)
- DO HELP
- GOTO QRTR
- +2 ;Validate year entered
- +3 NEW DGFY2B
- +4 SET DGFY2B=$$DGY2K^DGPTOD0($EXTRACT(DGFY,1,4))
- +5 IF DGFY2B<0
- DO HELP
- GOTO QRTR
- +6 SET DGFY2B=$$FMTE^XLFDT(DGFY2B)
- SET DGFY=DGFY2B_$EXTRACT(DGFY,5)
- SV WRITE !!,"Enter values by (I)NDIVIDUAL SERVICE or ",!?3,"(S)AME VALUE FOR ALL SERVICES: INDIVIDUAL// "
- SET Z="^INDIVIDUAL SERVICE^SAME VALUE FOR ALL SERVICES"
- SET X=""
- READ X:DTIME
- if X["^"!('$TEST)
- GOTO Q
- IF X=""
- SET X="I"
- WRITE X
- +1 DO IN^DGHELP
- IF %=-1
- WRITE !!?12,"CHOOSE FROM: ",!?12,"I - values are entered for each service",!?12,"S - one value is entered and used for all services"
- GOTO SV
- +2 SET DGS=$SELECT(X="I":1,1:0)
- SET DGHD="FY MED NEUR PSYCH REHAB SURG MED CTR"
- BE SET DGVALUES=""
- IF 'DGS
- WRITE !!,"MEDICAL CENTER BREAKEVEN DAYS: "
- DO DGBE
- if 'DGGO
- QUIT
- FOR %=1:1:6
- SET DGVALUES=DGVALUES_DGBE_"^"
- +1 IF DGS
- WRITE !
- FOR DGSV=1:1:6
- DO W
- DO DGBE
- if 'DGGO
- QUIT
- SET DGVALUES=DGVALUES_DGBE_"^"
- +2 if 'DGGO
- GOTO Q
- DO TABLE
- DO DRG
- CONTINU FOR DGGO=0:0
- SET %=1
- WRITE !!,"Do you wish to select another DRG"
- DO YN^DICN
- if %=0
- GOTO HELP1
- if %'=1
- QUIT
- DO DRG
- Q KILL DIC,DGBE,DGCURENT,DGFY,DGFY1,DGGO,DGHD,DGQRTR,DGS,DGSV,DGVALUES,DGY,DRG,%,I,X,Y,Z
- QUIT
- W WRITE !,$SELECT(DGSV=1:"MEDICINE",DGSV=2:"NEUROLOGY",DGSV=3:"PSYCHIATRY",DGSV=4:"REHAB MEDICINE",DGSV=5:"SURGERY",1:"MEDICAL CENTER"),$SELECT(DGSV'=6:" SERVICE",1:"")," BREAKEVEN DAYS: "
- QUIT
- TABLE WRITE !!,$JUSTIFY("TABLE OF BREAKEVEN VALUES YOU HAVE SELECTED:",55),!,DGHD,!
- FOR %=1:1:7
- WRITE "------- "
- +1 WRITE !,DGFY,?7
- FOR %=1:1:6
- WRITE ?3,$JUSTIFY($PIECE(DGVALUES,"^",%),10)
- +2 WRITE !
- QUIT
- DRG KILL DGCURENT
- SET DGCURENT=""
- SET DIC("A")="MOVE BREAKEVEN VALUES FROM TABLE INTO WHICH DRG? "
- SET DIC(0)="AEQM"
- SET DIC="^ICD("
- DO ^DIC
- if Y'>0
- QUIT
- SET DRG=+Y
- KILL DIC
- +1 if '$DATA(^ICD(DRG,"BE",0))
- SET ^(0)="^80.23"
- FOR %=1:1:4
- SET DGFY1=$SELECT(DGY:DGFY,1:DGFY_%)
- if '$DATA(^ICD(DRG,"BE",DGFY1,"S",0))
- SET ^(0)="^80.24SA"
- if DGY
- QUIT
- +2 IF DGY
- if $DATA(^ICD(DRG,"BE",DGFY,0))#2
- SET $PIECE(DGCURENT(1),"^",6)=$PIECE(^ICD(DRG,"BE",DGFY,0),"^",2)
- FOR %=1:1:5
- if $DATA(^ICD(DRG,"BE",DGFY,"S",%,0))
- SET $PIECE(DGCURENT(1),"^",%)=$PIECE(^ICD(DRG,"BE",DGFY,"S",%,0),"^",2)
- +3 IF 'DGY
- FOR %=1:1:4
- if $DATA(^ICD(DRG,"BE",DGFY_%,0))#2
- SET $PIECE(DGCURENT(%),"^",6)=$PIECE(^ICD(DRG,"BE",DGFY_%,0),"^",2)
- FOR I=1:1:5
- if $DATA(^ICD(DRG,"BE",DGFY_%,"S",I,0))
- SET $PIECE(DGCURENT(%),"^",I)=$PIECE(^ICD(DRG,"BE",DGFY_%,"S",I,0),"^",2)
- +4 FOR %=0:0
- SET %=$ORDER(DGCURENT(%))
- if %'>0
- QUIT
- IF DGCURENT(%)]""
- SET DGCURENT=1
- QUIT
- +5 WRITE !!,$SELECT(DGCURENT:" ",1:"NO")," BREAKEVEN VALUES CURRENTLY IN FILE FOR DRG: ",DRG,$SELECT(DGCURENT:"",'DGY:" for selected FY",1:" for selected FY/Q")
- IF DGCURENT
- WRITE !,DGHD,!
- FOR %=1:1:7
- WRITE "------- "
- +6 IF DGCURENT
- FOR I=0:0
- SET I=$ORDER(DGCURENT(I))
- if I'>0
- QUIT
- WRITE !,DGFY,$SELECT(DGY:"",1:I),?7
- FOR %=1:1:6
- WRITE ?3,$JUSTIFY($PIECE(DGCURENT(I),"^",%),10)
- C WRITE !!,"COPY VALUES FROM TABLE INTO DRG FILE"
- SET %=1
- DO YN^DICN
- if %=2
- QUIT
- IF %=0
- WRITE !!?12,"Y - to have your selected breakeven values",!?16,"copied into the DRG File",!?12,"N - to make no changes to the DRG File"
- GOTO C
- +1 if %'=1
- QUIT
- SET DGBE=$PIECE(DGVALUES,"^",6)
- DO WAIT^DICD
- DO ^DGPTBE2
- QUIT
- DGBE SET DGGO=""
- READ DGBE:DTIME
- if DGBE["^"!('$TEST)
- QUIT
- IF +DGBE'=DGBE!(DGBE>366)!(DGBE<0)!($LENGTH($PIECE(DGBE,".",2))>1)
- WRITE !,"enter a number between 0 and 366, up to 1 decimal digit"
- WRITE !,"BREAKEVEN DAYS: "
- GOTO DGBE
- +1 SET DGGO=1
- QUIT
- HELP WRITE !!?5,"Please enter a 4-digit fiscal year",$SELECT(DGY:" and quarter",1:"")," as 1999",$SELECT(DGY:"1",1:"")," for fiscal",!?5,"year 1999",$SELECT(DGY:" first quarter",1:""),". Fiscal years earlier than 1980 not allowed."
- QUIT
- HELP1 WRITE !!?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"
- GOTO CONTINU
