- 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
