DGPTMOVE ;ALB/JDS - MOVE DRG FY DATA TO UPPER LEVEL ; 26 AUG 84 14:15
;;5.3;Registration;**78,158,178,256,1015**;Aug 13, 1993;Build 21
;
EN F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="END" W !,X
S DGFLAG=0
D WHICH
I 'DGFLAG D FY
I 'DGFLAG D SET
Q K DGFLAG,DGFY,DGFY2K,DGWHICH,I,X
Q
;
;
WHICH ; select which option (local or all)
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
S DIR(0)="SM^A:ALL;L:LOCAL",DIR("A")="Copy which trim values"
S DIR("?",1)="Enter LOCAL if you want to use the local and national trim"
S DIR("?",2)="values from last year until new trim values are offically"
S DIR("?",3)="released. This will copy the local and national trim"
S DIR("?",4)="values into the next fiscal year. It will also copy the"
S DIR("?",5)="local trim values to the upper level of the DRG file for"
S DIR("?",6)="use on the <701> screen and in the DRG Calculation option."
S DIR("?",7)=" "
S DIR("?",8)="Choose ALL if local and national trim values have already"
S DIR("?",9)="been entered for the current fiscal year and you wish to"
S DIR("?",10)="copy those figures to the upper level of the DRG file for"
S DIR("?",11)="use on the <701> screen and in the DRG Calculation option."
S DIR("?",12)=" "
S DIR("?")="Choose L LOCAL or A for ALL."
D ^DIR
S DGWHICH=Y
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S DGFLAG=1 Q
Q
;
;
FY ; select fiscal year to copy from
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
S DIR(0)="F^2:2^I X'?2N K X",DIR("A")="Enter FISCAL YEAR to copy data from"
S DIR("?",1)="Enter the fiscal year from which you want to copy the trim"
S DIR("?",2)="values. The values you selected will be copied from this"
S DIR("?",3)="year to the upper level of the file."
I DGWHICH="L" D
. S DIR("?",3)=DIR("?",3)_" It will also copy"
. S DIR("?",4)="all trim data (local and national) to the fiscal year"
. S DIR("?",5)="following the year you select."
. S DIR("?",6)=" "
E D
. S DIR("?",4)=" "
S DIR("?")="Enter the fiscal year as NN (ex: '94' for fiscal year 1994)."
D ^DIR
S DGFY=Y
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S DGFLAG=1 Q
S DGFY2K=$$DGY2K^DGPTOD0(DGFY)
I '$D(^ICD("AFY",DGFY2K)) W !!,"No information has been entered yet for the selected fiscal year.",*7,! G FY
Q
;
;
SET ; set values into upper level and next fiscal year
N I,MULT,NODE,UPPER,Y
S Y=DGFY2K
X ^DD("DD")
W !!,"Copying WWU, ALOS, high trims, and low trims from FY",Y," to upper level of file."
I DGWHICH="L" D
.W !,"Also copying values from FY",Y," multiple to FY"
.S Y=DGFY2K+10000 X ^DD("DD") W Y," multiple."
W ".."
W ! F I=0:0 S I=$O(^ICD(I)) Q:I'>0 I $D(^ICD(I,"FY",DGFY2K,0)) D
. N NODE,MULT,UPPER
. S NODE=$G(^ICD(I,0)),MULT=$G(^ICD(I,"FY",DGFY2K,0))
. S $P(NODE,"^",15)="",$P(MULT,"^",15)="" ; ensures '^'s out to end of node
. I DGWHICH="A" D
. . S UPPER=$P(NODE,U,1)_U_$P(MULT,U,2,4)_U_$P(NODE,U,5,6)_U_$P(MULT,U,8,9)_U_$P(MULT,U,6,7)_U_$P(MULT,U,10)_U_$P(NODE,U,12)
. I DGWHICH="L" D
. . S UPPER=NODE
. . S $P(UPPER,"^",9)=$P(MULT,"^",6),$P(UPPER,"^",10)=$P(MULT,"^",7) ; sets local figures into upper level
. . S ^ICD(I,"FY",DGFY2K+10000,0)=(DGFY2K+10000)_"^"_$P(MULT,"^",2,10)
. S ^ICD(I,0)=UPPER
. W "."
W !!?17,"****** COPY COMPLETED ******",!!
Q
;
;
TEXT ;
;;This option is used to copy values from the FISCAL YEAR WEIGHTS&TRIMS
;;multiple of the DRG File for display purposes on the <701> screen and
;;in the DRG Calculation option and for the processing of the DRG Reports.
;;
;;Values are copied to the upper level of the DRG File for display purposes
;;and may also be copied from a fiscal year to the next fiscal year to
;;temporarily use a prior fiscal year's values until the current fiscal
;;year's values are available.
;;
;;Local values must previously have been entered into the DRG File through
;;the use of the 'Trim Point Entry' option.
;;
;;
;;END
DGPTMOVE ;ALB/JDS - MOVE DRG FY DATA TO UPPER LEVEL ; 26 AUG 84 14:15
+1 ;;5.3;Registration;**78,158,178,256,1015**;Aug 13, 1993;Build 21
+2 ;
EN FOR I=1:1
SET X=$PIECE($TEXT(TEXT+I),";;",2)
IF X="END"
QUIT
WRITE !,X
+1 SET DGFLAG=0
+2 DO WHICH
+3 IF 'DGFLAG
DO FY
+4 IF 'DGFLAG
DO SET
Q KILL DGFLAG,DGFY,DGFY2K,DGWHICH,I,X
+1 QUIT
+2 ;
+3 ;
WHICH ; select which option (local or all)
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+2 SET DIR(0)="SM^A:ALL;L:LOCAL"
SET DIR("A")="Copy which trim values"
+3 SET DIR("?",1)="Enter LOCAL if you want to use the local and national trim"
+4 SET DIR("?",2)="values from last year until new trim values are offically"
+5 SET DIR("?",3)="released. This will copy the local and national trim"
+6 SET DIR("?",4)="values into the next fiscal year. It will also copy the"
+7 SET DIR("?",5)="local trim values to the upper level of the DRG file for"
+8 SET DIR("?",6)="use on the <701> screen and in the DRG Calculation option."
+9 SET DIR("?",7)=" "
+10 SET DIR("?",8)="Choose ALL if local and national trim values have already"
+11 SET DIR("?",9)="been entered for the current fiscal year and you wish to"
+12 SET DIR("?",10)="copy those figures to the upper level of the DRG file for"
+13 SET DIR("?",11)="use on the <701> screen and in the DRG Calculation option."
+14 SET DIR("?",12)=" "
+15 SET DIR("?")="Choose L LOCAL or A for ALL."
+16 DO ^DIR
+17 SET DGWHICH=Y
+18 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET DGFLAG=1
QUIT
+19 QUIT
+20 ;
+21 ;
FY ; select fiscal year to copy from
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+2 SET DIR(0)="F^2:2^I X'?2N K X"
SET DIR("A")="Enter FISCAL YEAR to copy data from"
+3 SET DIR("?",1)="Enter the fiscal year from which you want to copy the trim"
+4 SET DIR("?",2)="values. The values you selected will be copied from this"
+5 SET DIR("?",3)="year to the upper level of the file."
+6 IF DGWHICH="L"
Begin DoDot:1
+7 SET DIR("?",3)=DIR("?",3)_" It will also copy"
+8 SET DIR("?",4)="all trim data (local and national) to the fiscal year"
+9 SET DIR("?",5)="following the year you select."
+10 SET DIR("?",6)=" "
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET DIR("?",4)=" "
End DoDot:1
+13 SET DIR("?")="Enter the fiscal year as NN (ex: '94' for fiscal year 1994)."
+14 DO ^DIR
+15 SET DGFY=Y
+16 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET DGFLAG=1
QUIT
+17 SET DGFY2K=$$DGY2K^DGPTOD0(DGFY)
+18 IF '$DATA(^ICD("AFY",DGFY2K))
WRITE !!,"No information has been entered yet for the selected fiscal year.",*7,!
GOTO FY
+19 QUIT
+20 ;
+21 ;
SET ; set values into upper level and next fiscal year
+1 NEW I,MULT,NODE,UPPER,Y
+2 SET Y=DGFY2K
+3 XECUTE ^DD("DD")
+4 WRITE !!,"Copying WWU, ALOS, high trims, and low trims from FY",Y," to upper level of file."
+5 IF DGWHICH="L"
Begin DoDot:1
+6 WRITE !,"Also copying values from FY",Y," multiple to FY"
+7 SET Y=DGFY2K+10000
XECUTE ^DD("DD")
WRITE Y," multiple."
End DoDot:1
+8 WRITE ".."
+9 WRITE !
FOR I=0:0
SET I=$ORDER(^ICD(I))
IF I'>0
QUIT
IF $DATA(^ICD(I,"FY",DGFY2K,0))
Begin DoDot:1
+10 NEW NODE,MULT,UPPER
+11 SET NODE=$GET(^ICD(I,0))
SET MULT=$GET(^ICD(I,"FY",DGFY2K,0))
+12 ; ensures '^'s out to end of node
SET $PIECE(NODE,"^",15)=""
SET $PIECE(MULT,"^",15)=""
+13 IF DGWHICH="A"
Begin DoDot:2
+14 SET UPPER=$PIECE(NODE,U,1)_U_$PIECE(MULT,U,2,4)_U_$PIECE(NODE,U,5,6)_U_$PIECE(MULT,U,8,9)_U_$PIECE(MULT,U,6,7)_U_$PIECE(MULT,U,10)_U_$PIECE(NODE,U,12)
End DoDot:2
+15 IF DGWHICH="L"
Begin DoDot:2
+16 SET UPPER=NODE
+17 ; sets local figures into upper level
SET $PIECE(UPPER,"^",9)=$PIECE(MULT,"^",6)
SET $PIECE(UPPER,"^",10)=$PIECE(MULT,"^",7)
+18 SET ^ICD(I,"FY",DGFY2K+10000,0)=(DGFY2K+10000)_"^"_$PIECE(MULT,"^",2,10)
End DoDot:2
+19 SET ^ICD(I,0)=UPPER
+20 WRITE "."
End DoDot:1
+21 WRITE !!?17,"****** COPY COMPLETED ******",!!
+22 QUIT
+23 ;
+24 ;
TEXT ;
+1 ;;This option is used to copy values from the FISCAL YEAR WEIGHTS&TRIMS
+2 ;;multiple of the DRG File for display purposes on the <701> screen and
+3 ;;in the DRG Calculation option and for the processing of the DRG Reports.
+4 ;;
+5 ;;Values are copied to the upper level of the DRG File for display purposes
+6 ;;and may also be copied from a fiscal year to the next fiscal year to
+7 ;;temporarily use a prior fiscal year's values until the current fiscal
+8 ;;year's values are available.
+9 ;;
+10 ;;Local values must previously have been entered into the DRG File through
+11 ;;the use of the 'Trim Point Entry' option.
+12 ;;
+13 ;;
+14 ;;END
