DGBTDIST ;ALB/SCK-BENEFICIARY TRAVEL DEPARTURE CITY DISTANCE ENTER/EDIT;1/21/93 2/1/93 4/26/93
;;1.0;Beneficiary Travel;;September 25, 2001
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
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 (+%)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTDIST 3380 printed Dec 13, 2024@01:40:32 Page 2
DGBTDIST ;ALB/SCK-BENEFICIARY TRAVEL DEPARTURE CITY DISTANCE ENTER/EDIT;1/21/93 2/1/93 4/26/93
+1 ;;1.0;Beneficiary Travel;;September 25, 2001
+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
+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 (+%)
