source: WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTUTL.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1DGBTUTL ;ALB/SCK - BENEFICIARY/TRAVEL UTILITY ROUTINES; 1/6/93@1130
2 ;;1.0;Beneficiary Travel;;September 25, 2001
3START ;
4 Q
5MILES(DGBTRN,DGBTDX) ;
6 ; DGBTRN holds the record no., and DGBTDX holds the division pointer passed in during the function call
7 N DGBTML,XX,DGBTCHK
8 S XX="",(DGBTML,DGBTDEF)=0
9 F XX=0:0 S XX=$O(^DGBT(392.1,DGBTRN,1,XX)) Q:+XX'>0!(DGBTML>0) D
10 . S DGBTCHK=$P($G(^DGBT(392.1,DGBTRN,1,XX,0)),U,1) I DGBTDX=DGBTCHK S DGBTML=$P($G(^(0)),U,2)
11 I DGBTML'>0 S DGBTML=$P($G(^DGBT(392.1,DGBTRN,0)),U,3),DGBTDEF=1
12 K DGBTRN,DGBTDX
13 Q DGBTML
14DICLKUP(DGBTRN,DGBTDX,DGBTP) ;
15 N RETURN,XX
16 S DIC="^DGBT(392.1,DGBTRN,1,",DIC(0)="MZX",X=DGBTDX,RETURN=""
17 D ^DIC
18 I +Y>0 D
19 . I DGBTP=4 S RETURN=$S(+$P($G(Y(0)),U,4)>0:$P($G(Y(0)),U,5),1:"")
20 . I DGBTP=3 S RETURN=$S(+$P($G(Y(0)),U,3)>0:$P(^(0),U,3),1:0)
21 Q RETURN
22DEPCTY(ZIPCDE) ;
23 N RETURN
24 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
25 K ZIPCDE
26 Q RETURN
27EXIT ;
28 Q
29TEST ;
30 W !,"DATE/TIME REQUIRED.."
31 S X="OLD",DTOUT=1
32 Q
Note: See TracBrowser for help on using the repository browser.