DGBTDIST.m

DGBTDIST ;ALB/SCK-BENEFICIARY TRAVEL DEPARTURE CITY DISTANCE ENTER/EDIT;1/21/93  2/1/93 4/26/93

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

 Q

START ;

 N DGBTMDIV,DGBTDIV,XX,DA,DO,X,NEWDIV,CITY

 D HOME^%ZIS W @IOF

 D WAIT^DICD,STCHK^DGBTSRCH

 I '$$CHECKS^DGBTDST1 W !,"No Problems were found in the Distance Data."

 E  G:'$$FIX CLEAR

CLEAR ; set division and whether multi or single instit.

 S DGBTMDIV=+$P($G(^DG(43,1,"GL")),U,2),NEWDIV=0,DGBTDIV=+$P($G(^DG(43,1,"GL")),U,3),ERR=0

LKUP ; lookup departure city using DIR reader for input and DIC call for lookup

 D HEADER

 K DIR S DIR(0)="FO^1:30",DIR("A",1)="",DIR("A")="Enter Departure City",DIR("?",1)="Enter the name for the departure city",DIR("?")="Name must be free text, 1-30 characters in length"

 D ^DIR K DIR G:$D(DIRUT) EXIT S (CITY,X)=Y

 L +^DGBT(392.1):3 I '$T W !?5,*7,"FILE IN USE, PLEASE TRY AGAIN LATER" G EXIT

 S DIC="^DGBT(392.1,",DIC(0)="ELQMZ",DLAYGO="392",DIC("DR")="" D ^DIC K DIC,DLAYGO L -^DGBT(392.1) S (REC,DA)=+Y G:$D(DTOUT)!($D(DUOUT)) EXIT

 S:$P(Y,U,3)=1 NEWDIV=1 G:X["?"!(+Y'>0) LKUP

 G:$$ADDIT CLEAR

DIS ; check to add additional divisions

 I DGBTMDIV F XX=2:1 Q:'$$NEXTDV  D DIV

 G CLEAR

EXIT ;

 K REC,Y,DTOUT,DUOUT,DIRUT,DR,NEWDIV,DGBTMDIV,CITY,DGBTDIV,ERR,%,DIC,DIR

 Q

 ;

NEXTDV() ;

 N Y

 S DIR("A")="Enter another division for this departure city",DIR("B")="YES"

 S DIR(0)="YO",DIR("?")="Enter a 'Y'es to add or enter another division, or 'N'o to exit to the Departure City prompt"

 D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S Y=0

NEXTDIQ Q (+Y)

 ;

ADDIT() ; enter data for new city and create 1st division

 N ERR

 S DIE="^DGBT(392.1,",DA=REC,DR=".01"_"CITY OR TOWN"_";2;4" D ^DIE I '$D(DA) S ERR=1 G ADDQ

 I X="",$P($G(^DGBT(392.1,DA,0)),U,2)']""&($P($G(^DGBT(392.1,DA,0)),U,4)']"") D DELETE S ERR=1 G ADDQ

 I $D(DTOUT)!($D(Y))!('$D(DA)) S ERR=1 G ADDQ

 D MILES ; print default mileage message

 S DR=$S(NEWDIV:"100///"_DGBTDIV,1:"100")

 S DR(2,392.1001)="I 'DGBTMDIV S Y=""@2"";.01;@2;2;3;4//"_"NO"_";I X=""""!(X=0) S Y=""@1"";5;@1" D ^DIE K DIE

 D DEFMILE L -^DGBT(392.1) ; check 1st div mile vs default miles

ADDQ Q ($D(ERR))

 ;

MILES ; print default mileage message

 W:DGBTMDIV&(NEWDIV) !!?10,*7,"THE MILEAGE FOR THE SELECTED DIVISION WILL BE USED AS THE",!?10,"DEFAULT MILEAGE FOR THIS DEPARTURE CITY.",!!

 Q

DEFMILE ; compare city's default mileage vs. 1st divisions mileage, update if necessary

 I $P($G(^DGBT(392.1,REC,0)),U,3)'=$P($G(^DGBT(392.1,REC,1,1,0)),U,2) D

 . S DIE="^DGBT(392.1,",DA=REC,DR="3///^S X=+$P($G(^DGBT(392.1,DA,1,1,0)),U,2)" D ^DIE K DIE

 Q

DIV ; add additional divisions to existing city

 L +^DGBT(392.1):3 I '$T W !?5,*7,"FILE IN USE, PLEASE TRY AGAIN LATER" G EXIT

 S DIE="^DGBT(392.1,",DA=REC,DO=XX,DR="100",DR(2,392.1001)=".01;2;3;4//"_"NO"_";I X=""""!(X=0) S Y=""@1"";5;@1" D ^DIE K DIE

 L -^DGBT(392.1)

 Q

HEADER ;

 W !!,"Enter the CITY as the point of origin.  The MILEAGE/ONE-WAY",!,"is the distance from the CITY to the Medical Center Division.",!

 Q

 ;

DELETE ;

 W !!?5,*7,"INCOMPLETE INFORMATION WAS ENTERED, BOTH THE STATE AND ZIP CODE",!?5,"ARE REQUIRED, RECORD DELETED",!

 K DIE S DIK="^DGBT(392.1,",DA=REC D ^DIK K DIK S ERR=1

 Q

FIX() ;

 W !,"You can either correct these problems, or add a new departure city."

 W !,"CORRECT PROBLEMS"

 D:$$YESNO^DGBTSRCH=1 START^DGBTSRCH

 Q (+%)

DGBTDIST  ;ALB/SCK-BENEFICIARY TRAVEL DEPARTURE CITY DISTANCE ENTER/EDIT;1/21/93  2/1/93 4/26/93

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

 +2        QUIT 

START     ;

 +1        NEW DGBTMDIV,DGBTDIV,XX,DA,DO,X,NEWDIV,CITY

 +2        DO HOME^%ZIS

           WRITE @IOF

 +3        DO WAIT^DICD

           DO STCHK^DGBTSRCH

 +4        IF '$$CHECKS^DGBTDST1

               WRITE !,"No Problems were found in the Distance Data."

 +5       IF '$TEST

               IF '$$FIX

                   GOTO CLEAR

CLEAR     ; set division and whether multi or single instit.

 +1        SET DGBTMDIV=+$PIECE($GET(^DG(43,1,"GL")),U,2)

           SET NEWDIV=0

           SET DGBTDIV=+$PIECE($GET(^DG(43,1,"GL")),U,3)

           SET ERR=0

LKUP      ; lookup departure city using DIR reader for input and DIC call for lookup

 +1        DO HEADER

 +2        KILL DIR

           SET DIR(0)="FO^1:30"

           SET DIR("A",1)=""

           SET DIR("A")="Enter Departure City"

           SET DIR("?",1)="Enter the name for the departure city"

           SET DIR("?")="Name must be free text, 1-30 characters in length"

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO EXIT

           SET (CITY,X)=Y

 +4        LOCK +^DGBT(392.1):3

           IF '$TEST

               WRITE !?5,*7,"FILE IN USE, PLEASE TRY AGAIN LATER"

               GOTO EXIT

 +5        SET DIC="^DGBT(392.1,"

           SET DIC(0)="ELQMZ"

           SET DLAYGO="392"

           SET DIC("DR")=""

           DO ^DIC

           KILL DIC,DLAYGO

           LOCK -^DGBT(392.1)

           SET (REC,DA)=+Y

           IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO EXIT

 +6        IF $PIECE(Y,U,3)=1

               SET NEWDIV=1

           IF X["?"!(+Y'>0)

               GOTO LKUP

 +7        IF $$ADDIT

               GOTO CLEAR

DIS       ; check to add additional divisions

 +1        IF DGBTMDIV

               FOR XX=2:1

                   IF '$$NEXTDV

                       QUIT 

                   DO DIV

 +2        GOTO CLEAR

EXIT      ;

 +1        KILL REC,Y,DTOUT,DUOUT,DIRUT,DR,NEWDIV,DGBTMDIV,CITY,DGBTDIV,ERR,%,DIC,DIR

 +2        QUIT 

 +3       ;

NEXTDV()  ;

 +1        NEW Y

 +2        SET DIR("A")="Enter another division for this departure city"

           SET DIR("B")="YES"

 +3        SET DIR(0)="YO"

           SET DIR("?")="Enter a 'Y'es to add or enter another division, or 'N'o to exit to the Departure City prompt"

 +4        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)!($DATA(DTOUT))

               SET Y=0

NEXTDIQ    QUIT (+Y)

 +1       ;

ADDIT()   ; enter data for new city and create 1st division

 +1        NEW ERR

 +2        SET DIE="^DGBT(392.1,"

           SET DA=REC

           SET DR=".01"_"CITY OR TOWN"_";2;4"

           DO ^DIE

           IF '$DATA(DA)

               SET ERR=1

               GOTO ADDQ

 +3        IF X=""

               IF $PIECE($GET(^DGBT(392.1,DA,0)),U,2)']""&($PIECE($GET(^DGBT(392.1,DA,0)),U,4)']"")

                   DO DELETE

                   SET ERR=1

                   GOTO ADDQ

 +4        IF $DATA(DTOUT)!($DATA(Y))!('$DATA(DA))

               SET ERR=1

               GOTO ADDQ

 +5       ; print default mileage message

           DO MILES

 +6        SET DR=$SELECT(NEWDIV:"100///"_DGBTDIV,1:"100")

 +7        SET DR(2,392.1001)="I 'DGBTMDIV S Y=""@2"";.01;@2;2;3;4//"_"NO"_";I X=""""!(X=0) S Y=""@1"";5;@1"

           DO ^DIE

           KILL DIE

 +8       ; check 1st div mile vs default miles

           DO DEFMILE

           LOCK -^DGBT(392.1)

ADDQ       QUIT ($DATA(ERR))

 +1       ;

MILES     ; print default mileage message

 +1        IF DGBTMDIV&(NEWDIV)

               WRITE !!?10,*7,"THE MILEAGE FOR THE SELECTED DIVISION WILL BE USED AS THE",!?10,"DEFAULT MILEAGE FOR THIS DEPARTURE CITY.",!!

 +2        QUIT 

DEFMILE   ; compare city's default mileage vs. 1st divisions mileage, update if necessary

 +1        IF $PIECE($GET(^DGBT(392.1,REC,0)),U,3)'=$PIECE($GET(^DGBT(392.1,REC,1,1,0)),U,2)

               Begin DoDot:1

 +2                SET DIE="^DGBT(392.1,"

                   SET DA=REC

                   SET DR="3///^S X=+$P($G(^DGBT(392.1,DA,1,1,0)),U,2)"

                   DO ^DIE

                   KILL DIE

               End DoDot:1

 +3        QUIT 

DIV       ; add additional divisions to existing city

 +1        LOCK +^DGBT(392.1):3

           IF '$TEST

               WRITE !?5,*7,"FILE IN USE, PLEASE TRY AGAIN LATER"

               GOTO EXIT

 +2        SET DIE="^DGBT(392.1,"

           SET DA=REC

           SET DO=XX

           SET DR="100"

           SET DR(2,392.1001)=".01;2;3;4//"_"NO"_";I X=""""!(X=0) S Y=""@1"";5;@1"

           DO ^DIE

           KILL DIE

 +3        LOCK -^DGBT(392.1)

 +4        QUIT 

HEADER    ;

 +1        WRITE !!,"Enter the CITY as the point of origin.  The MILEAGE/ONE-WAY",!,"is the distance from the CITY to the Medical Center Division.",!

 +2        QUIT 

 +3       ;

DELETE    ;

 +1        WRITE !!?5,*7,"INCOMPLETE INFORMATION WAS ENTERED, BOTH THE STATE AND ZIP CODE",!?5,"ARE REQUIRED, RECORD DELETED",!

 +2        KILL DIE

           SET DIK="^DGBT(392.1,"

           SET DA=REC

           DO ^DIK

           KILL DIK

           SET ERR=1

 +3        QUIT 

FIX()     ;

 +1        WRITE !,"You can either correct these problems, or add a new departure city."

 +2        WRITE !,"CORRECT PROBLEMS"

 +3        IF $$YESNO^DGBTSRCH=1

               DO START^DGBTSRCH

 +4        QUIT (+%)