DGBTID ;ALB/MRY - LOCAL VENDOR IDENTIFIER DATA ;4/23/03 09:11 AM
;;1.0;Beneficiary Travel;**2**;September 25, 2001
START ;DISPLAY IDENTIFYING DATA FROM RECORD IN FILE 392.31
N LN0,LN1,LN2,LN3,PHONE,PH,A,T,T1,NO,ADDR1,CITY,STATE
N ZIP,ADDR2,FAX,IEN
;
;GET CURRENT RECORD NODES NEEDED TO DISPLAY IDENTIFIERS
;
S IEN=+Y
S LN0=$G(^DGBT(392.31,IEN,0))
S LN1=$G(^DGBT(392.31,IEN,1))
S LN2=$G(^DGBT(392.31,IEN,2))
S LN3=$G(^DGBT(392.31,IEN,3))
;
;DISPLAY ADDRESS DATA IN IDENTIFIERS
;
S ADDR1="ADD:"_$P(LN1,U)
D EN^DDIOL(ADDR1,"","!")
;
;DISPLAY DATA (BYPASS PHONE) IF VENDOR IS INACTIVATED.
;
I $P(LN3,U,2)'="" G IEN
;
;DISPLAY DATA IN IDENTIFIERS IF VENDOR IN NOT INACTIVATED
;
S PHONE="PH:"
S PH=$P(LN0,U,6) I $P(LN0,U,5) S PH=$P(LN0,U,5)_" "_PH
D PHONE
S PHONE=PHONE_PH
D EN^DDIOL(PHONE,"","?54")
;
;COME HERE TO DISPLAY THE RECORD'S INTERNAL ENTRY NUMBER
;
IEN S NO=" "_IEN
S NO="NO:"_$E(NO,$L(NO)-5,99)
D EN^DDIOL(NO,"","?71")
;
;NOW DISPLAY SECOND ADDRESS LINE IN IDENTIFIERS
;
S CITY=$P(LN2,U)
S STATE=$P(LN2,U,2)
I STATE>0 D
. S STATE=$P($G(^DIC(5,STATE,0)),U,2)
S ZIP=$P(LN2,U,3)
I ZIP?9N S ZIP=$E(ZIP,1,5)_"-"_$E(ZIP,6,9)
S ADDR2=""
I CITY]"",STATE]"" S ADDR2=ADDR2_CITY_", "_STATE
I CITY="",STATE]"" S ADDR2=ADDR2_STATE
I CITY]"",STATE="" S ADDR2=ADDR2_CITY
S:ADDR2]"" ADDR2=ADDR2_" "_ZIP
S:ADDR2="" ADDR2=ADDR2_ZIP
D EN^DDIOL(ADDR2,"","!?8")
;
S FAX="FAX:"
K PH
S PH=$P(LN0,U,8) I $P(LN0,U,7) S PH=$P(LN0,U,7)_" "_PH
D PHONE
S FAX=FAX_PH
D EN^DDIOL(FAX,"","?64")
;
;END OF ADDRESS LINES
;
;LETS INFORM USER IF THIS VENDOR IS INACTIVATED
;
D EN^DDIOL("","","!")
I $P(LN3,U,2)'="" D
. D EN^DDIOL("****THIS VENDOR IS INACTIVE","","?0")
;
Q
;
PHONE ;PHONE/FAX FORMATTING
;
S PH=$TR(PH,"abcdefghijklmnoprstuvwxy","222333444555666777888999")
S PH=$TR(PH,"ABCDEFGHIJKLMNOPRSTUVWXY","222333444555666777888999")
I PH]"" D
. I PH'?.N D Q
. . S A=1
. . F S T=$E(PH,1) D:T?1N S:T'?1N PH=$E(PH,2,99) Q:PH=""
. . . S PH(A)=""
. . . F S T1=$E(PH,1) Q:T1'?1N S PH(A)=PH(A)_T1,PH=$E(PH,2,99) Q:PH=""
. . . Q:PH=""
. . . S A=A+1
. . . Q
. . I $G(PH(1))="011" S PH="INTERN'L" Q
. . 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
. . 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
. . I $L($G(PH(1)))=3,$L($G(PH(2)))=4 S PH=" "_PH(1)_"-"_PH(2) Q
. . 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)
. . Q
. I $L(PH)>9 S PH=$E(PH,1,3)_" "_$E(PH,4,6)_"-"_$E(PH,7,10) Q
. I $L(PH)>6 S PH=" "_$E(PH,1,3)_"-"_$E(PH,4,7) Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTID 2764 printed Nov 22, 2024@16:51 Page 2
DGBTID ;ALB/MRY - LOCAL VENDOR IDENTIFIER DATA ;4/23/03 09:11 AM
+1 ;;1.0;Beneficiary Travel;**2**;September 25, 2001
START ;DISPLAY IDENTIFYING DATA FROM RECORD IN FILE 392.31
+1 NEW LN0,LN1,LN2,LN3,PHONE,PH,A,T,T1,NO,ADDR1,CITY,STATE
+2 NEW ZIP,ADDR2,FAX,IEN
+3 ;
+4 ;GET CURRENT RECORD NODES NEEDED TO DISPLAY IDENTIFIERS
+5 ;
+6 SET IEN=+Y
+7 SET LN0=$GET(^DGBT(392.31,IEN,0))
+8 SET LN1=$GET(^DGBT(392.31,IEN,1))
+9 SET LN2=$GET(^DGBT(392.31,IEN,2))
+10 SET LN3=$GET(^DGBT(392.31,IEN,3))
+11 ;
+12 ;DISPLAY ADDRESS DATA IN IDENTIFIERS
+13 ;
+14 SET ADDR1="ADD:"_$PIECE(LN1,U)
+15 DO EN^DDIOL(ADDR1,"","!")
+16 ;
+17 ;DISPLAY DATA (BYPASS PHONE) IF VENDOR IS INACTIVATED.
+18 ;
+19 IF $PIECE(LN3,U,2)'=""
GOTO IEN
+20 ;
+21 ;DISPLAY DATA IN IDENTIFIERS IF VENDOR IN NOT INACTIVATED
+22 ;
+23 SET PHONE="PH:"
+24 SET PH=$PIECE(LN0,U,6)
IF $PIECE(LN0,U,5)
SET PH=$PIECE(LN0,U,5)_" "_PH
+25 DO PHONE
+26 SET PHONE=PHONE_PH
+27 DO EN^DDIOL(PHONE,"","?54")
+28 ;
+29 ;COME HERE TO DISPLAY THE RECORD'S INTERNAL ENTRY NUMBER
+30 ;
IEN SET NO=" "_IEN
+1 SET NO="NO:"_$EXTRACT(NO,$LENGTH(NO)-5,99)
+2 DO EN^DDIOL(NO,"","?71")
+3 ;
+4 ;NOW DISPLAY SECOND ADDRESS LINE IN IDENTIFIERS
+5 ;
+6 SET CITY=$PIECE(LN2,U)
+7 SET STATE=$PIECE(LN2,U,2)
+8 IF STATE>0
Begin DoDot:1
+9 SET STATE=$PIECE($GET(^DIC(5,STATE,0)),U,2)
End DoDot:1
+10 SET ZIP=$PIECE(LN2,U,3)
+11 IF ZIP?9N
SET ZIP=$EXTRACT(ZIP,1,5)_"-"_$EXTRACT(ZIP,6,9)
+12 SET ADDR2=""
+13 IF CITY]""
IF STATE]""
SET ADDR2=ADDR2_CITY_", "_STATE
+14 IF CITY=""
IF STATE]""
SET ADDR2=ADDR2_STATE
+15 IF CITY]""
IF STATE=""
SET ADDR2=ADDR2_CITY
+16 if ADDR2]""
SET ADDR2=ADDR2_" "_ZIP
+17 if ADDR2=""
SET ADDR2=ADDR2_ZIP
+18 DO EN^DDIOL(ADDR2,"","!?8")
+19 ;
+20 SET FAX="FAX:"
+21 KILL PH
+22 SET PH=$PIECE(LN0,U,8)
IF $PIECE(LN0,U,7)
SET PH=$PIECE(LN0,U,7)_" "_PH
+23 DO PHONE
+24 SET FAX=FAX_PH
+25 DO EN^DDIOL(FAX,"","?64")
+26 ;
+27 ;END OF ADDRESS LINES
+28 ;
+29 ;LETS INFORM USER IF THIS VENDOR IS INACTIVATED
+30 ;
+31 DO EN^DDIOL("","","!")
+32 IF $PIECE(LN3,U,2)'=""
Begin DoDot:1
+33 DO EN^DDIOL("****THIS VENDOR IS INACTIVE","","?0")
End DoDot:1
+34 ;
+35 QUIT
+36 ;
PHONE ;PHONE/FAX FORMATTING
+1 ;
+2 SET PH=$TRANSLATE(PH,"abcdefghijklmnoprstuvwxy","222333444555666777888999")
+3 SET PH=$TRANSLATE(PH,"ABCDEFGHIJKLMNOPRSTUVWXY","222333444555666777888999")
+4 IF PH]""
Begin DoDot:1
+5 IF PH'?.N
Begin DoDot:2
+6 SET A=1
+7 FOR
SET T=$EXTRACT(PH,1)
if T?1N
Begin DoDot:3
+8 SET PH(A)=""
+9 FOR
SET T1=$EXTRACT(PH,1)
if T1'?1N
QUIT
SET PH(A)=PH(A)_T1
SET PH=$EXTRACT(PH,2,99)
if PH=""
QUIT
+10 if PH=""
QUIT
+11 SET A=A+1
+12 QUIT
End DoDot:3
if T'?1N
SET PH=$EXTRACT(PH,2,99)
if PH=""
QUIT
+13 IF $GET(PH(1))="011"
SET PH="INTERN'L"
QUIT
+14 IF $LENGTH($GET(PH(1)))=1
IF $LENGTH($GET(PH(2)))=3
IF $LENGTH($GET(PH(3)))=3
IF $LENGTH($GET(PH(4)))=4
SET PH=PH(2)_"-"_PH(3)_"-"_PH(4)
QUIT
+15 IF $LENGTH($GET(PH(1)))=3
IF $LENGTH($GET(PH(2)))=3
IF $LENGTH($GET(PH(3)))=4
SET PH=PH(1)_" "_PH(2)_"-"_PH(3)
QUIT
+16 IF $LENGTH($GET(PH(1)))=3
IF $LENGTH($GET(PH(2)))=4
SET PH=" "_PH(1)_"-"_PH(2)
QUIT
+17 IF $LENGTH($GET(PH(1)))=3
IF $LENGTH($GET(PH(2)))=7
SET PH=PH(1)_" "_$EXTRACT(PH(2),1,3)_"-"_$EXTRACT(PH(2),4,7)
+18 QUIT
End DoDot:2
QUIT
+19 IF $LENGTH(PH)>9
SET PH=$EXTRACT(PH,1,3)_" "_$EXTRACT(PH,4,6)_"-"_$EXTRACT(PH,7,10)
QUIT
+20 IF $LENGTH(PH)>6
SET PH=" "_$EXTRACT(PH,1,3)_"-"_$EXTRACT(PH,4,7)
QUIT
+21 QUIT
End DoDot:1
+22 QUIT
