Routine: DGPTMOVE

DGPTMOVE ;ALB/JDS - MOVE DRG FY DATA TO UPPER LEVEL ; 26 AUG 84  14:15

 ;;5.3;Registration;**78,158,178,256**;Aug 13, 1993

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

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

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

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  ******",!!

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTMOVE   3924     printed  Mar 13, 2025@21:57:37                                                                                                                                                                                                    Page 2

DGPTMOVE  ;ALB/JDS - MOVE DRG FY DATA TO UPPER LEVEL ; 26 AUG 84  14:15

 +1       ;;5.3;Registration;**78,158,178,256**;Aug 13, 1993

 +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

DGPTMOVE.m