DGBTUTL.m

DGBTUTL ;ALB/SCK - BENEFICIARY/TRAVEL UTILITY ROUTINES; 1/6/93@1130

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

START ;

 Q

MILES(DGBTRN,DGBTDX) ;

 ; DGBTRN holds the record no., and DGBTDX holds the division pointer passed in during the function call

 N DGBTML,XX,DGBTCHK

 S XX="",(DGBTML,DGBTDEF)=0

 F XX=0:0 S XX=$O(^DGBT(392.1,DGBTRN,1,XX)) Q:+XX'>0!(DGBTML>0)  D

 . S DGBTCHK=$P($G(^DGBT(392.1,DGBTRN,1,XX,0)),U,1) I DGBTDX=DGBTCHK S DGBTML=$P($G(^(0)),U,2)

 I DGBTML'>0 S DGBTML=$P($G(^DGBT(392.1,DGBTRN,0)),U,3),DGBTDEF=1

 K DGBTRN,DGBTDX

 Q DGBTML

DICLKUP(DGBTRN,DGBTDX,DGBTP) ;

 N RETURN,XX

 S DIC="^DGBT(392.1,DGBTRN,1,",DIC(0)="MZX",X=DGBTDX,RETURN=""

 D ^DIC

 I +Y>0 D

 . I DGBTP=4 S RETURN=$S(+$P($G(Y(0)),U,4)>0:$P($G(Y(0)),U,5),1:"")

 . I DGBTP=3 S RETURN=$S(+$P($G(Y(0)),U,3)>0:$P(^(0),U,3),1:0)

 Q RETURN

DEPCTY(ZIPCDE) ;

 N RETURN

 S DIC="^DGBT(392.1,",DIC(0)="MZ",X=$S($L(ZIPCDE)>5:$E(ZIPCDE,1,5),1:ZIPCDE) D ^DIC S RETURN=Y K DIC

 K ZIPCDE

 Q RETURN

EXIT ;

 Q

TEST ;

 W !,"DATE/TIME REQUIRED.."

 S X="OLD",DTOUT=1

 Q

DGBTUTL   ;ALB/SCK - BENEFICIARY/TRAVEL UTILITY ROUTINES; 1/6/93@1130

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

START     ;

 +1        QUIT 

MILES(DGBTRN,DGBTDX) ;

 +1       ; DGBTRN holds the record no., and DGBTDX holds the division pointer passed in during the function call

 +2        NEW DGBTML,XX,DGBTCHK

 +3        SET XX=""

           SET (DGBTML,DGBTDEF)=0

 +4        FOR XX=0:0

               SET XX=$ORDER(^DGBT(392.1,DGBTRN,1,XX))

               IF +XX'>0!(DGBTML>0)

                   QUIT 

               Begin DoDot:1

 +5                SET DGBTCHK=$PIECE($GET(^DGBT(392.1,DGBTRN,1,XX,0)),U,1)

                   IF DGBTDX=DGBTCHK

                       SET DGBTML=$PIECE($GET(^(0)),U,2)

               End DoDot:1

 +6        IF DGBTML'>0

               SET DGBTML=$PIECE($GET(^DGBT(392.1,DGBTRN,0)),U,3)

               SET DGBTDEF=1

 +7        KILL DGBTRN,DGBTDX

 +8        QUIT DGBTML

DICLKUP(DGBTRN,DGBTDX,DGBTP) ;

 +1        NEW RETURN,XX

 +2        SET DIC="^DGBT(392.1,DGBTRN,1,"

           SET DIC(0)="MZX"

           SET X=DGBTDX

           SET RETURN=""

 +3        DO ^DIC

 +4        IF +Y>0

               Begin DoDot:1

 +5                IF DGBTP=4

                       SET RETURN=$SELECT(+$PIECE($GET(Y(0)),U,4)>0:$PIECE($GET(Y(0)),U,5),1:"")

 +6                IF DGBTP=3

                       SET RETURN=$SELECT(+$PIECE($GET(Y(0)),U,3)>0:$PIECE(^(0),U,3),1:0)

               End DoDot:1

 +7        QUIT RETURN

DEPCTY(ZIPCDE) ;

 +1        NEW RETURN

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

           SET DIC(0)="MZ"

           SET X=$SELECT($LENGTH(ZIPCDE)>5:$EXTRACT(ZIPCDE,1,5),1:ZIPCDE)

           DO ^DIC

           SET RETURN=Y

           KILL DIC

 +3        KILL ZIPCDE

 +4        QUIT RETURN

EXIT      ;

 +1        QUIT 

TEST      ;

 +1        WRITE !,"DATE/TIME REQUIRED.."

 +2        SET X="OLD"

           SET DTOUT=1

 +3        QUIT