DGPTTRIM.m

DGPTTRIM ;ALB/JDS - SET UP DRG INFO ; 26 AUG 84  14:16

 ;;5.3;Registration;**158,606,1015**;Aug 13, 1993;Build 21

 ;

 W !!,"SET UP DRG VALUES FOR FISCAL YEARS",!!

FY R !,"Fiscal year to set up data for: ",DGFY:DTIME G Q:DGFY=""!(DGFY["^") I DGFY'?2N W !!,"Enter the fiscal year as 'NN' (ex: '84' for fiscal year 1984).",*7,*7,! G FY

 S DGFY2K=$$DGY2K^DGPTOD0(DGFY)

ASK ;W !! S DIC="^ICD(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DGDRG=^ICD(+Y,0)

 W !! S DIC="^ICD(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DGDRG=$$DRG^ICDGTDRG(+Y)

 W !!,"**National DRG Values - not editable**",!?5,$J("WWU: ",16),$P(DGDRG,U,2),!?5,$J("Low Trim Days: ",16),$P(DGDRG,U,3),!?5,$J("High Trim Days: ",16),$P(DGDRG,U,4),!?5,$J("ALOS: ",16),$P(DGDRG,U,8),!!

 S DA=+Y,DR="20///"_DGFY,DR(2,80.22)="6;7",DIE=DIC D ^DIE S:'$D(Y) ^ICD("AFY",DGFY2K)="" G ASK

Q K DA,DGDRG,DGFY,DIC,DIE,DR,Y Q

DGPTTRIM  ;ALB/JDS - SET UP DRG INFO ; 26 AUG 84  14:16

 +1       ;;5.3;Registration;**158,606,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3        WRITE !!,"SET UP DRG VALUES FOR FISCAL YEARS",!!

FY         READ !,"Fiscal year to set up data for: ",DGFY:DTIME

           IF DGFY=""!(DGFY["^")

               GOTO Q

           IF DGFY'?2N

               WRITE !!,"Enter the fiscal year as 'NN' (ex: '84' for fiscal year 1984).",*7,*7,!

               GOTO FY

 +1        SET DGFY2K=$$DGY2K^DGPTOD0(DGFY)

ASK       ;W !! S DIC="^ICD(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DGDRG=^ICD(+Y,0)

 +1        WRITE !!

           SET DIC="^ICD("

           SET DIC(0)="AEQMZ"

           DO ^DIC

           IF Y'>0

               GOTO Q

           SET DGDRG=$$DRG^ICDGTDRG(+Y)

 +2        WRITE !!,"**National DRG Values - not editable**",!?5,$JUSTIFY("WWU: ",16),$PIECE(DGDRG,U,2),!?5,$JUSTIFY("Low Trim Days: ",16),$PIECE(DGDRG,U,3),!?5,$JUSTIFY("High Trim Days: ",16),$PIECE(DGDRG,U,4),!?5,$JUSTIFY("ALOS: ",16),$PIECE(DGDRG,U,8),

!!

 +3        SET DA=+Y

           SET DR="20///"_DGFY

           SET DR(2,80.22)="6;7"

           SET DIE=DIC

           DO ^DIE

           IF '$DATA(Y)

               SET ^ICD("AFY",DGFY2K)=""

           GOTO ASK

Q          KILL DA,DGDRG,DGFY,DIC,DIE,DR,Y

           QUIT