ICDZCOST ; IHS/ANMC/MWR - CONTRACT CARE COST ESTIMATOR ; AUGUST 14, 1992
;; VERSION 8.0;DRG GROUPER;;AUG 14, 1992
; ADAPTED FROM GIS/OHPRD/IHS;CONTRACT CARE COST ESTIMATOR;
S U="^"
;
CHECK ;
I '$D(ICDDRGN) D G EXIT
.W !!,"The variable, ICDDRGN (the DRG number), is not defined."
I '$D(^ICD(ICDDRGN,0)) D G EXIT
.W !!,"No entry for ",ICDDRGN," in the DRG file."
I '$D(^ICD(ICDDRGN,9999999)) D G EXIT
.W !!,"No HCFA/IHS WEIGHT data stored for this entry in the DRG file."
I '$D(^AMER("2.1",0)) D G EXIT
.W !!,"(There is no ER CONTRACT COST ESTIMATOR FILE.)"
;
WEIGHT ; GET HCFA/IHS WEIGHT FROM DRG FILE.
S ICDDRGW=+^ICD(ICDDRGN,9999999)
;
COSTS ; BUILD ARRAY OF ESTIMATED COSTS
K ICDTEMP
S ICDN=0 F S ICDN=$O(^AMER(2.1,ICDN)) Q:'ICDN S ICDOK="" D
.S ICDX=^AMER(2.1,ICDN,0)
.S ICDNAME=$P(ICDX,U,4)
.S ICDCOST=(ICDDRGW*$P(ICDX,U,2))+$P(ICDX,U,3)
.I ICDCOST>0 S ICDOK1=""
.S ICDCOST=+$J(ICDCOST,1,2)
.S ICDTEMP(ICDCOST)=ICDNAME
;
I '$D(ICDOK) D G EXIT
.W !!,"(There are no entries in the ER CONTRACT COST ESTIMATOR FILE.)"
I '$D(ICDOK1) D G EXIT
.W !!,"(The entries in the ER CONTRACT COST ESTIMATOR FILE contain"
.W " no cost data.)"
;
OUTPUT ;
W !!,"ESTIMATED COSTS FOR DRG = ",ICDDRGN
W !!,"Remember, costs do not include physician fees!",!
;
S ICDCOST=0 F ICDI=1:1 S ICDCOST=$O(ICDTEMP(ICDCOST)) Q:'ICDCOST D
.S ICDX=ICDTEMP(ICDCOST)
.S ICDX=$E(ICDX,1,30)
.S ICDY=$E("..............................",1,30-$L(ICDX))
.W !,ICDI,") ",?4,ICDX,ICDY,?37
.S X=ICDCOST,X2="2$" D COMMA^%DTC W X
.K ICDX,ICDY,X,X2
;
EXIT ;
K DIR,ICDCOST,ICDDRGN,ICDDRGW,ICDDRG,ICDI,ICDOK,ICDOK1,ICDX,ICDY
Q
ICDZCOST ; IHS/ANMC/MWR - CONTRACT CARE COST ESTIMATOR ; AUGUST 14, 1992
+1 ;; VERSION 8.0;DRG GROUPER;;AUG 14, 1992
+2 ; ADAPTED FROM GIS/OHPRD/IHS;CONTRACT CARE COST ESTIMATOR;
+3 SET U="^"
+4 ;
CHECK ;
+1 IF '$DATA(ICDDRGN)
Begin DoDot:1
+2 WRITE !!,"The variable, ICDDRGN (the DRG number), is not defined."
End DoDot:1
GOTO EXIT
+3 IF '$DATA(^ICD(ICDDRGN,0))
Begin DoDot:1
+4 WRITE !!,"No entry for ",ICDDRGN," in the DRG file."
End DoDot:1
GOTO EXIT
+5 IF '$DATA(^ICD(ICDDRGN,9999999))
Begin DoDot:1
+6 WRITE !!,"No HCFA/IHS WEIGHT data stored for this entry in the DRG file."
End DoDot:1
GOTO EXIT
+7 IF '$DATA(^AMER("2.1",0))
Begin DoDot:1
+8 WRITE !!,"(There is no ER CONTRACT COST ESTIMATOR FILE.)"
End DoDot:1
GOTO EXIT
+9 ;
WEIGHT ; GET HCFA/IHS WEIGHT FROM DRG FILE.
+1 SET ICDDRGW=+^ICD(ICDDRGN,9999999)
+2 ;
COSTS ; BUILD ARRAY OF ESTIMATED COSTS
+1 KILL ICDTEMP
+2 SET ICDN=0
FOR
SET ICDN=$ORDER(^AMER(2.1,ICDN))
IF 'ICDN
QUIT
SET ICDOK=""
Begin DoDot:1
+3 SET ICDX=^AMER(2.1,ICDN,0)
+4 SET ICDNAME=$PIECE(ICDX,U,4)
+5 SET ICDCOST=(ICDDRGW*$PIECE(ICDX,U,2))+$PIECE(ICDX,U,3)
+6 IF ICDCOST>0
SET ICDOK1=""
+7 SET ICDCOST=+$JUSTIFY(ICDCOST,1,2)
+8 SET ICDTEMP(ICDCOST)=ICDNAME
End DoDot:1
+9 ;
+10 IF '$DATA(ICDOK)
Begin DoDot:1
+11 WRITE !!,"(There are no entries in the ER CONTRACT COST ESTIMATOR FILE.)"
End DoDot:1
GOTO EXIT
+12 IF '$DATA(ICDOK1)
Begin DoDot:1
+13 WRITE !!,"(The entries in the ER CONTRACT COST ESTIMATOR FILE contain"
+14 WRITE " no cost data.)"
End DoDot:1
GOTO EXIT
+15 ;
OUTPUT ;
+1 WRITE !!,"ESTIMATED COSTS FOR DRG = ",ICDDRGN
+2 WRITE !!,"Remember, costs do not include physician fees!",!
+3 ;
+4 SET ICDCOST=0
FOR ICDI=1:1
SET ICDCOST=$ORDER(ICDTEMP(ICDCOST))
IF 'ICDCOST
QUIT
Begin DoDot:1
+5 SET ICDX=ICDTEMP(ICDCOST)
+6 SET ICDX=$EXTRACT(ICDX,1,30)
+7 SET ICDY=$EXTRACT("..............................",1,30-$LENGTH(ICDX))
+8 WRITE !,ICDI,") ",?4,ICDX,ICDY,?37
+9 SET X=ICDCOST
SET X2="2$"
DO COMMA^%DTC
WRITE X
+10 KILL ICDX,ICDY,X,X2
End DoDot:1
+11 ;
EXIT ;
+1 KILL DIR,ICDCOST,ICDDRGN,ICDDRGW,ICDDRG,ICDI,ICDOK,ICDOK1,ICDX,ICDY
+2 QUIT
