| 1 | DGBTDIST ;ALB/SCK-BENEFICIARY TRAVEL DEPARTURE CITY DISTANCE ENTER/EDIT;1/21/93 2/1/93 4/26/93
|
---|
| 2 | ;;1.0;Beneficiary Travel;;September 25, 2001
|
---|
| 3 | Q
|
---|
| 4 | START ;
|
---|
| 5 | N DGBTMDIV,DGBTDIV,XX,DA,DO,X,NEWDIV,CITY
|
---|
| 6 | D HOME^%ZIS W @IOF
|
---|
| 7 | D WAIT^DICD,STCHK^DGBTSRCH
|
---|
| 8 | I '$$CHECKS^DGBTDST1 W !,"No Problems were found in the Distance Data."
|
---|
| 9 | E G:'$$FIX CLEAR
|
---|
| 10 | CLEAR ; set division and whether multi or single instit.
|
---|
| 11 | S DGBTMDIV=+$P($G(^DG(43,1,"GL")),U,2),NEWDIV=0,DGBTDIV=+$P($G(^DG(43,1,"GL")),U,3),ERR=0
|
---|
| 12 | LKUP ; lookup departure city using DIR reader for input and DIC call for lookup
|
---|
| 13 | D HEADER
|
---|
| 14 | 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"
|
---|
| 15 | D ^DIR K DIR G:$D(DIRUT) EXIT S (CITY,X)=Y
|
---|
| 16 | L +^DGBT(392.1):3 I '$T W !?5,*7,"FILE IN USE, PLEASE TRY AGAIN LATER" G EXIT
|
---|
| 17 | 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
|
---|
| 18 | S:$P(Y,U,3)=1 NEWDIV=1 G:X["?"!(+Y'>0) LKUP
|
---|
| 19 | G:$$ADDIT CLEAR
|
---|
| 20 | DIS ; check to add additional divisions
|
---|
| 21 | I DGBTMDIV F XX=2:1 Q:'$$NEXTDV D DIV
|
---|
| 22 | G CLEAR
|
---|
| 23 | EXIT ;
|
---|
| 24 | K REC,Y,DTOUT,DUOUT,DIRUT,DR,NEWDIV,DGBTMDIV,CITY,DGBTDIV,ERR,%,DIC,DIR
|
---|
| 25 | Q
|
---|
| 26 | ;
|
---|
| 27 | NEXTDV() ;
|
---|
| 28 | N Y
|
---|
| 29 | S DIR("A")="Enter another division for this departure city",DIR("B")="YES"
|
---|
| 30 | 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"
|
---|
| 31 | D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S Y=0
|
---|
| 32 | NEXTDIQ Q (+Y)
|
---|
| 33 | ;
|
---|
| 34 | ADDIT() ; enter data for new city and create 1st division
|
---|
| 35 | N ERR
|
---|
| 36 | S DIE="^DGBT(392.1,",DA=REC,DR=".01"_"CITY OR TOWN"_";2;4" D ^DIE I '$D(DA) S ERR=1 G ADDQ
|
---|
| 37 | 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
|
---|
| 38 | I $D(DTOUT)!($D(Y))!('$D(DA)) S ERR=1 G ADDQ
|
---|
| 39 | D MILES ; print default mileage message
|
---|
| 40 | S DR=$S(NEWDIV:"100///"_DGBTDIV,1:"100")
|
---|
| 41 | 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
|
---|
| 42 | D DEFMILE L -^DGBT(392.1) ; check 1st div mile vs default miles
|
---|
| 43 | ADDQ Q ($D(ERR))
|
---|
| 44 | ;
|
---|
| 45 | MILES ; print default mileage message
|
---|
| 46 | W:DGBTMDIV&(NEWDIV) !!?10,*7,"THE MILEAGE FOR THE SELECTED DIVISION WILL BE USED AS THE",!?10,"DEFAULT MILEAGE FOR THIS DEPARTURE CITY.",!!
|
---|
| 47 | Q
|
---|
| 48 | DEFMILE ; compare city's default mileage vs. 1st divisions mileage, update if necessary
|
---|
| 49 | I $P($G(^DGBT(392.1,REC,0)),U,3)'=$P($G(^DGBT(392.1,REC,1,1,0)),U,2) D
|
---|
| 50 | . 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
|
---|
| 51 | Q
|
---|
| 52 | DIV ; add additional divisions to existing city
|
---|
| 53 | L +^DGBT(392.1):3 I '$T W !?5,*7,"FILE IN USE, PLEASE TRY AGAIN LATER" G EXIT
|
---|
| 54 | 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
|
---|
| 55 | L -^DGBT(392.1)
|
---|
| 56 | Q
|
---|
| 57 | HEADER ;
|
---|
| 58 | W !!,"Enter the CITY as the point of origin. The MILEAGE/ONE-WAY",!,"is the distance from the CITY to the Medical Center Division.",!
|
---|
| 59 | Q
|
---|
| 60 | ;
|
---|
| 61 | DELETE ;
|
---|
| 62 | W !!?5,*7,"INCOMPLETE INFORMATION WAS ENTERED, BOTH THE STATE AND ZIP CODE",!?5,"ARE REQUIRED, RECORD DELETED",!
|
---|
| 63 | K DIE S DIK="^DGBT(392.1,",DA=REC D ^DIK K DIK S ERR=1
|
---|
| 64 | Q
|
---|
| 65 | FIX() ;
|
---|
| 66 | W !,"You can either correct these problems, or add a new departure city."
|
---|
| 67 | W !,"CORRECT PROBLEMS"
|
---|
| 68 | D:$$YESNO^DGBTSRCH=1 START^DGBTSRCH
|
---|
| 69 | Q (+%)
|
---|