- 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