DGRUGFY.m

DGRUGFY ;ALB/MLI - ENTER FISCAL YEAR RUG II WWU VALUES ; 20 JAN 88 @1000

 ;;5.3;Registration;**173,1015**;Aug 13, 1993;Build 21

 W !,"You are about to enter national fiscal year RUG values.  All entries must be"

 W !,"completed, otherwise those that you have entered will be deleted."

ASKFY W !,"Enter fiscal year (4 digits): " R X:DTIME G QUIT:X=""!(X="^")!('$T),FYH:'(X?4N) S %DT="E",%DT(0)=2870000 D ^%DT I Y'>0 G ASKFY

 S DGFY=+Y K Y F DGI=1:1:17 I $S(DGI<17:1,DGFY<2870000:1,DGFY>2880000:1,1:0) D ASK G:'$D(DGOUT) CHECK

CHECK F I=1:1:17 I $S(I<17:1,DGFY<2870000:1,DGFY>2880000:1,1:0),$S('$D(^DG(45.91,I,"FY",DGFY,0)):1,$P(^(0),"^",2)']"":1,1:0) W !,"RUG",I," WWU value not assigned" S DGNO(I)=I

COMP I $D(DGNO) W !,"Do you want to enter these values now" S %=2 D YN^DICN I %Y["?" W !?5,"ANSWER 'Y'ES OR 'N'O" G COMP

 I $D(DGNO) G:%=1 FILLIN G REASK

QUIT K %,%DT,%Y,D,DA,D0,D1,DI,DGFY,DGI,DGNO,DGOUT,DIC,DIE,DIK,DR,I,X,Y Q

FILLIN F DGI=0:0 S DGI=$O(DGNO(DGI)) Q:DGI'>0  D ASK Q:'$D(DGOUT)

 K DGNO G CHECK

REASK W !,"WARNING:  All existing WWU values for fiscal year ",$$FMTE^XLFDT(DGFY)," will be deleted.  OK to continue" S %=1 D YN^DICN I %Y["?" W !?5,"ANSWER 'Y'ES OR 'N'O" G REASK

 G COMP:%=2 S DA=DGFY F DGI=1:1:17 I $S(DGI<17:1,DGFY<2870000:1,DGFY>2880000:1,1:0) S DA(1)=DGI,DIK="^DG(45.91,"_DA(1)_",""FY""," D ^DIK

 G QUIT

ASK W !,"Enter RUG",DGI," value" S DA=DGI,DIE="^DG(45.91,",DR="1///"_DGFY,DR(2,45.9101)="1;S DGOUT=1" K DE,DQ,DGOUT D ^DIE

 Q

FYH W !?5,"Enter fiscal year (4 digits) from which you want RUG-II WWU values.",!?5,"Must not precede 1987." G ASKFY

DGRUGFY   ;ALB/MLI - ENTER FISCAL YEAR RUG II WWU VALUES ; 20 JAN 88 @1000

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

 +2        WRITE !,"You are about to enter national fiscal year RUG values.  All entries must be"

 +3        WRITE !,"completed, otherwise those that you have entered will be deleted."

ASKFY      WRITE !,"Enter fiscal year (4 digits): "

           READ X:DTIME

           IF X=""!(X="^")!('$TEST)

               GOTO QUIT

           IF '(X?4N)

               GOTO FYH

           SET %DT="E"

           SET %DT(0)=2870000

           DO ^%DT

           IF Y'>0

               GOTO ASKFY

 +1        SET DGFY=+Y

           KILL Y

           FOR DGI=1:1:17

               IF $SELECT(DGI<17:1,DGFY<2870000:1,DGFY>2880000:1,1:0)

                   DO ASK

                   IF '$DATA(DGOUT)

                       GOTO CHECK

CHECK      FOR I=1:1:17

               IF $SELECT(I<17:1,DGFY<2870000:1,DGFY>2880000:1,1:0)

                   IF $SELECT('$DATA(^DG(45.91,I,"FY",DGFY,0)):1,$PIECE(^(0),"^",2)']"":1,1:0)

                       WRITE !,"RUG",I," WWU value not assigned"

                       SET DGNO(I)=I

COMP       IF $DATA(DGNO)

               WRITE !,"Do you want to enter these values now"

               SET %=2

               DO YN^DICN

               IF %Y["?"

                   WRITE !?5,"ANSWER 'Y'ES OR 'N'O"

                   GOTO COMP

 +1        IF $DATA(DGNO)

               IF %=1

                   GOTO FILLIN

               GOTO REASK

QUIT       KILL %,%DT,%Y,D,DA,D0,D1,DI,DGFY,DGI,DGNO,DGOUT,DIC,DIE,DIK,DR,I,X,Y

           QUIT 

FILLIN     FOR DGI=0:0

               SET DGI=$ORDER(DGNO(DGI))

               IF DGI'>0

                   QUIT 

               DO ASK

               IF '$DATA(DGOUT)

                   QUIT 

 +1        KILL DGNO

           GOTO CHECK

REASK      WRITE !,"WARNING:  All existing WWU values for fiscal year ",$$FMTE^XLFDT(DGFY)," will be deleted.  OK to continue"

           SET %=1

           DO YN^DICN

           IF %Y["?"

               WRITE !?5,"ANSWER 'Y'ES OR 'N'O"

               GOTO REASK

 +1        IF %=2

               GOTO COMP

           SET DA=DGFY

           FOR DGI=1:1:17

               IF $SELECT(DGI<17:1,DGFY<2870000:1,DGFY>2880000:1,1:0)

                   SET DA(1)=DGI

                   SET DIK="^DG(45.91,"_DA(1)_",""FY"","

                   DO ^DIK

 +2        GOTO QUIT

ASK        WRITE !,"Enter RUG",DGI," value"

           SET DA=DGI

           SET DIE="^DG(45.91,"

           SET DR="1///"_DGFY

           SET DR(2,45.9101)="1;S DGOUT=1"

           KILL DE,DQ,DGOUT

           DO ^DIE

 +1        QUIT 

FYH        WRITE !?5,"Enter fiscal year (4 digits) from which you want RUG-II WWU values.",!?5,"Must not precede 1987."

           GOTO ASKFY