source: FOIAVistA/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTID.m@ 847

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1DGBTID ;ALB/MRY - LOCAL VENDOR IDENTIFIER DATA ;4/23/03 09:11 AM
2 ;;1.0;Beneficiary Travel;**2**;September 25, 2001
3START ;DISPLAY IDENTIFYING DATA FROM RECORD IN FILE 392.31
4 N LN0,LN1,LN2,LN3,PHONE,PH,A,T,T1,NO,ADDR1,CITY,STATE
5 N ZIP,ADDR2,FAX,IEN
6 ;
7 ;GET CURRENT RECORD NODES NEEDED TO DISPLAY IDENTIFIERS
8 ;
9 S IEN=+Y
10 S LN0=$G(^DGBT(392.31,IEN,0))
11 S LN1=$G(^DGBT(392.31,IEN,1))
12 S LN2=$G(^DGBT(392.31,IEN,2))
13 S LN3=$G(^DGBT(392.31,IEN,3))
14 ;
15 ;DISPLAY ADDRESS DATA IN IDENTIFIERS
16 ;
17 S ADDR1="ADD:"_$P(LN1,U)
18 D EN^DDIOL(ADDR1,"","!")
19 ;
20 ;DISPLAY DATA (BYPASS PHONE) IF VENDOR IS INACTIVATED.
21 ;
22 I $P(LN3,U,2)'="" G IEN
23 ;
24 ;DISPLAY DATA IN IDENTIFIERS IF VENDOR IN NOT INACTIVATED
25 ;
26 S PHONE="PH:"
27 S PH=$P(LN0,U,6) I $P(LN0,U,5) S PH=$P(LN0,U,5)_" "_PH
28 D PHONE
29 S PHONE=PHONE_PH
30 D EN^DDIOL(PHONE,"","?54")
31 ;
32 ;COME HERE TO DISPLAY THE RECORD'S INTERNAL ENTRY NUMBER
33 ;
34IEN S NO=" "_IEN
35 S NO="NO:"_$E(NO,$L(NO)-5,99)
36 D EN^DDIOL(NO,"","?71")
37 ;
38 ;NOW DISPLAY SECOND ADDRESS LINE IN IDENTIFIERS
39 ;
40 S CITY=$P(LN2,U)
41 S STATE=$P(LN2,U,2)
42 I STATE>0 D
43 . S STATE=$P($G(^DIC(5,STATE,0)),U,2)
44 S ZIP=$P(LN2,U,3)
45 I ZIP?9N S ZIP=$E(ZIP,1,5)_"-"_$E(ZIP,6,9)
46 S ADDR2=""
47 I CITY]"",STATE]"" S ADDR2=ADDR2_CITY_", "_STATE
48 I CITY="",STATE]"" S ADDR2=ADDR2_STATE
49 I CITY]"",STATE="" S ADDR2=ADDR2_CITY
50 S:ADDR2]"" ADDR2=ADDR2_" "_ZIP
51 S:ADDR2="" ADDR2=ADDR2_ZIP
52 D EN^DDIOL(ADDR2,"","!?8")
53 ;
54 S FAX="FAX:"
55 K PH
56 S PH=$P(LN0,U,8) I $P(LN0,U,7) S PH=$P(LN0,U,7)_" "_PH
57 D PHONE
58 S FAX=FAX_PH
59 D EN^DDIOL(FAX,"","?64")
60 ;
61 ;END OF ADDRESS LINES
62 ;
63 ;LETS INFORM USER IF THIS VENDOR IS INACTIVATED
64 ;
65 D EN^DDIOL("","","!")
66 I $P(LN3,U,2)'="" D
67 . D EN^DDIOL("****THIS VENDOR IS INACTIVE","","?0")
68 ;
69 Q
70 ;
71PHONE ;PHONE/FAX FORMATTING
72 ;
73 S PH=$TR(PH,"abcdefghijklmnoprstuvwxy","222333444555666777888999")
74 S PH=$TR(PH,"ABCDEFGHIJKLMNOPRSTUVWXY","222333444555666777888999")
75 I PH]"" D
76 . I PH'?.N D Q
77 . . S A=1
78 . . F S T=$E(PH,1) D:T?1N S:T'?1N PH=$E(PH,2,99) Q:PH=""
79 . . . S PH(A)=""
80 . . . F S T1=$E(PH,1) Q:T1'?1N S PH(A)=PH(A)_T1,PH=$E(PH,2,99) Q:PH=""
81 . . . Q:PH=""
82 . . . S A=A+1
83 . . . Q
84 . . I $G(PH(1))="011" S PH="INTERN'L" Q
85 . . I $L($G(PH(1)))=1,$L($G(PH(2)))=3,$L($G(PH(3)))=3,$L($G(PH(4)))=4 S PH=PH(2)_"-"_PH(3)_"-"_PH(4) Q
86 . . I $L($G(PH(1)))=3,$L($G(PH(2)))=3,$L($G(PH(3)))=4 S PH=PH(1)_" "_PH(2)_"-"_PH(3) Q
87 . . I $L($G(PH(1)))=3,$L($G(PH(2)))=4 S PH=" "_PH(1)_"-"_PH(2) Q
88 . . I $L($G(PH(1)))=3,$L($G(PH(2)))=7 S PH=PH(1)_" "_$E(PH(2),1,3)_"-"_$E(PH(2),4,7)
89 . . Q
90 . I $L(PH)>9 S PH=$E(PH,1,3)_" "_$E(PH,4,6)_"-"_$E(PH,7,10) Q
91 . I $L(PH)>6 S PH=" "_$E(PH,1,3)_"-"_$E(PH,4,7) Q
92 . Q
93 Q
Note: See TracBrowser for help on using the repository browser.