DGQEUT3 ;ALB/RPM - VIC REPLACEMENT UTILITIES #3 ; 12/22/03
;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
;
; This routine contains the following address selection and retrieval
; utilities:
; $$GETFADD - retrieves facility address
; $$GETPTCA - retrieves a confidential, temporary or permanent address
; $$ISCONF - determines if confidential address is active
; $$ISTEMP - determines if temporary address active
; $$ISFRGN - determines if selected address is a foreign address
; $$GETABRV - converts pointer to STATE(#5) file to state abbreviation
;
Q ;no direct entry
;
GETFADD(DGFADD) ;retrieve facility address
; This function retrieves a facility's address from the INSTITUTION(#4)
; file and places the address in an array mapped to be compatible with
; the ADD^VADPT call. A valid DUZ(2) is used to determine the
; pointer to the INSTITUTION(#4) file, otherwise, $$SITE^VASITE() is
; used.
;
; Supported References:
; DBIA #2171: $$PADD^XUAF4
; DBIA #10112: $$SITE^VASITE
;
; Input:
; none
;
; Output:
; DGFADD - facility address array, pass by reference
; Array subscripts are:
; "1" - Street Line 1
; "2" - null
; "3" - null
; "4" - City
; "5" - State (2 character abbreviation)
; "6" - Zip
; Function value - address type on success [4:facility]; 0 on failure
;
N DGADR ;return value of $$PADD api
N DGINST ;INSTITUTION (#4) file pointer
N DGTYPE ;function value address type
;
S DGTYPE=0
;
I $G(DUZ(2))>0 S DGINST=DUZ(2)
E S DGINST=$P($$SITE^VASITE(),U,1)
;
I $D(^DIC(4,DGINST)) D
. S DGADR=$$PADD^XUAF4(DGINST)
. ;
. S DGFADD(1)=$P(DGADR,U,1) ;street 1
. S DGFADD(2)="" ;placeholder
. S DGFADD(3)="" ;placeholder
. S DGFADD(4)=$P(DGADR,U,2) ;city
. S DGFADD(5)=$P(DGADR,U,3) ;state
. S DGFADD(6)=$P(DGADR,U,4) ;zip
. ;
. ;success
. S DGTYPE=4
;
Q DGTYPE
;
GETPTCA(DGDFN,DGADDR) ;select confidential, temporary or permanent address
; This function uses ADD^VADPT to retrieve a patient address array and
; selects the address to be used for mailing. The address selection
; priority is as follows:
; 1) Active "ELIGIBILITY/ENROLLMENT"-category Confidential Address
; 2) Active Temporary Address
; 3) Permanent Address
; The selected address is returned in an array format.
;
; Supported Reference:
; DBIA #10061: ADD^VADPT
;
; Input:
; DGDFN - pointer to patient in PATIENT (#2) file
;
; Output:
; DGADDR - selected address array, pass by reference
; Array subscripts are:
; "1" - Street Line 1
; "2" - Street Line 2
; "3" - Street Line 3
; "4" - City
; "5" - State (abbreviation)
; "6" - Zip
; "7" - County
; Function value - set of codes for address type [1:permanent,
; 2:temporary,3:confidential]
;
N DFN ;input parameter for ADD^VADPT
N DGI ;generic counter
N DGLINE1 ;array node of Street Line 1
N DGSUB ;return array subscript
N DGTYPE ;function value - address type
N VAERR ;error return from VADPT
N VAPA ;result array from VADPT
;
S DGTYPE=0
;
I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
. S DFN=DGDFN
. D ADD^VADPT
. ;
. ;determine address type
. S DGTYPE=$S($$ISCONF(.VAPA,"ELIGIBILITY/ENROLLMENT"):3,$$ISTEMP(.VAPA):2,1:1)
. ;
. ;copy VADPT array into return array
. S DGLINE1=$S(DGTYPE=3:13,1:1)
. S DGSUB=0
. F DGI=DGLINE1:1:DGLINE1+6 D
. . S DGSUB=DGSUB+1
. . I DGSUB=5 D ;get state abbreviation
. . . S DGADDR(DGSUB)=$$GETABRV($P(VAPA(DGI),U))
. . E D
. . . S DGADDR(DGSUB)=$P(VAPA(DGI),U)
;
Q DGTYPE
;
;
ISCONF(DGADD,DGCAT) ;is confidential address active?
; This function accepts an address array returned from a call to
; ADD^VADPT and determines if an active confidential address exists
; for the given category.
;
; DGADD - VAPA address array from ADD^VADPT
; DGCAT - confidential address category
;
; Output:
; Function value - 1:confidential address active,0:confidential
; address inactive
;
N DGI ;generic counter
N DGRSLT ;function value
;
S DGRSLT=0
I $G(DGADD(12)),$G(DGCAT)]"" D
. S DGI=0
. F S DGI=$O(DGADD(22,DGI)) Q:'DGI D Q:DGRSLT
. . Q:$P($G(DGADD(22,DGI)),U,2)'=DGCAT
. . Q:$P($G(DGADD(22,DGI)),U,3)'="Y"
. . S DGRSLT=1
;
Q DGRSLT
;
;
ISTEMP(DGADD) ;is temporary address active?
; This function determines if an active temporary address exists.
;
; Input:
; DGADD - address array in VADPT VAPA format
;
; Output:
; Function value - 1 on active temp address, 0 on failure
;
Q $G(DGADD(9))>0
;
;
ISFRGN(DGADD) ;is selected address foreign?
; This function determines if the address selected by VADPT is a
; foreign address.
;
; Input:
; DGADD - address aray in VADPT VAPA format
;
; Output:
; Function value - returns 1 on foreign address, 0 not a foreign
; address
;
Q $G(DGADD(7))="999"
;
;
GETABRV(DGIEN) ;retrieve state abbreviation
; This function retrieves the abbreviation for a state from the STAT
; (#5) file for a given IEN.
;
; Supported Reference:
; DBIA #10056: FileMan Read access to STATE (#5) file
;
; Input:
; DGIEN - pointer to a state in the STATE (#5) file
;
; Output:
; Function value - state abbreviation on success, "" on failure
;
N DGABRV ;function value
N DGERR ;FM error value
;
S DGABRV=""
;
I $G(DGIEN)>0,$D(^DIC(5,DGIEN,0)) D
. S DGABRV=$$GET1^DIQ(5,DGIEN_",",1,"","","DGERR")
. S:$D(DGERR) DGABRV=""
;
Q DGABRV
DGQEUT3 ;ALB/RPM - VIC REPLACEMENT UTILITIES #3 ; 12/22/03
+1 ;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; This routine contains the following address selection and retrieval
+4 ; utilities:
+5 ; $$GETFADD - retrieves facility address
+6 ; $$GETPTCA - retrieves a confidential, temporary or permanent address
+7 ; $$ISCONF - determines if confidential address is active
+8 ; $$ISTEMP - determines if temporary address active
+9 ; $$ISFRGN - determines if selected address is a foreign address
+10 ; $$GETABRV - converts pointer to STATE(#5) file to state abbreviation
+11 ;
+12 ;no direct entry
QUIT
+13 ;
GETFADD(DGFADD) ;retrieve facility address
+1 ; This function retrieves a facility's address from the INSTITUTION(#4)
+2 ; file and places the address in an array mapped to be compatible with
+3 ; the ADD^VADPT call. A valid DUZ(2) is used to determine the
+4 ; pointer to the INSTITUTION(#4) file, otherwise, $$SITE^VASITE() is
+5 ; used.
+6 ;
+7 ; Supported References:
+8 ; DBIA #2171: $$PADD^XUAF4
+9 ; DBIA #10112: $$SITE^VASITE
+10 ;
+11 ; Input:
+12 ; none
+13 ;
+14 ; Output:
+15 ; DGFADD - facility address array, pass by reference
+16 ; Array subscripts are:
+17 ; "1" - Street Line 1
+18 ; "2" - null
+19 ; "3" - null
+20 ; "4" - City
+21 ; "5" - State (2 character abbreviation)
+22 ; "6" - Zip
+23 ; Function value - address type on success [4:facility]; 0 on failure
+24 ;
+25 ;return value of $$PADD api
NEW DGADR
+26 ;INSTITUTION (#4) file pointer
NEW DGINST
+27 ;function value address type
NEW DGTYPE
+28 ;
+29 SET DGTYPE=0
+30 ;
+31 IF $GET(DUZ(2))>0
SET DGINST=DUZ(2)
+32 IF '$TEST
SET DGINST=$PIECE($$SITE^VASITE(),U,1)
+33 ;
+34 IF $DATA(^DIC(4,DGINST))
Begin DoDot:1
+35 SET DGADR=$$PADD^XUAF4(DGINST)
+36 ;
+37 ;street 1
SET DGFADD(1)=$PIECE(DGADR,U,1)
+38 ;placeholder
SET DGFADD(2)=""
+39 ;placeholder
SET DGFADD(3)=""
+40 ;city
SET DGFADD(4)=$PIECE(DGADR,U,2)
+41 ;state
SET DGFADD(5)=$PIECE(DGADR,U,3)
+42 ;zip
SET DGFADD(6)=$PIECE(DGADR,U,4)
+43 ;
+44 ;success
+45 SET DGTYPE=4
End DoDot:1
+46 ;
+47 QUIT DGTYPE
+48 ;
GETPTCA(DGDFN,DGADDR) ;select confidential, temporary or permanent address
+1 ; This function uses ADD^VADPT to retrieve a patient address array and
+2 ; selects the address to be used for mailing. The address selection
+3 ; priority is as follows:
+4 ; 1) Active "ELIGIBILITY/ENROLLMENT"-category Confidential Address
+5 ; 2) Active Temporary Address
+6 ; 3) Permanent Address
+7 ; The selected address is returned in an array format.
+8 ;
+9 ; Supported Reference:
+10 ; DBIA #10061: ADD^VADPT
+11 ;
+12 ; Input:
+13 ; DGDFN - pointer to patient in PATIENT (#2) file
+14 ;
+15 ; Output:
+16 ; DGADDR - selected address array, pass by reference
+17 ; Array subscripts are:
+18 ; "1" - Street Line 1
+19 ; "2" - Street Line 2
+20 ; "3" - Street Line 3
+21 ; "4" - City
+22 ; "5" - State (abbreviation)
+23 ; "6" - Zip
+24 ; "7" - County
+25 ; Function value - set of codes for address type [1:permanent,
+26 ; 2:temporary,3:confidential]
+27 ;
+28 ;input parameter for ADD^VADPT
NEW DFN
+29 ;generic counter
NEW DGI
+30 ;array node of Street Line 1
NEW DGLINE1
+31 ;return array subscript
NEW DGSUB
+32 ;function value - address type
NEW DGTYPE
+33 ;error return from VADPT
NEW VAERR
+34 ;result array from VADPT
NEW VAPA
+35 ;
+36 SET DGTYPE=0
+37 ;
+38 IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+39 SET DFN=DGDFN
+40 DO ADD^VADPT
+41 ;
+42 ;determine address type
+43 SET DGTYPE=$SELECT($$ISCONF(.VAPA,"ELIGIBILITY/ENROLLMENT"):3,$$ISTEMP(.VAPA):2,1:1)
+44 ;
+45 ;copy VADPT array into return array
+46 SET DGLINE1=$SELECT(DGTYPE=3:13,1:1)
+47 SET DGSUB=0
+48 FOR DGI=DGLINE1:1:DGLINE1+6
Begin DoDot:2
+49 SET DGSUB=DGSUB+1
+50 ;get state abbreviation
IF DGSUB=5
Begin DoDot:3
+51 SET DGADDR(DGSUB)=$$GETABRV($PIECE(VAPA(DGI),U))
End DoDot:3
+52 IF '$TEST
Begin DoDot:3
+53 SET DGADDR(DGSUB)=$PIECE(VAPA(DGI),U)
End DoDot:3
End DoDot:2
End DoDot:1
+54 ;
+55 QUIT DGTYPE
+56 ;
+57 ;
ISCONF(DGADD,DGCAT) ;is confidential address active?
+1 ; This function accepts an address array returned from a call to
+2 ; ADD^VADPT and determines if an active confidential address exists
+3 ; for the given category.
+4 ;
+5 ; DGADD - VAPA address array from ADD^VADPT
+6 ; DGCAT - confidential address category
+7 ;
+8 ; Output:
+9 ; Function value - 1:confidential address active,0:confidential
+10 ; address inactive
+11 ;
+12 ;generic counter
NEW DGI
+13 ;function value
NEW DGRSLT
+14 ;
+15 SET DGRSLT=0
+16 IF $GET(DGADD(12))
IF $GET(DGCAT)]""
Begin DoDot:1
+17 SET DGI=0
+18 FOR
SET DGI=$ORDER(DGADD(22,DGI))
IF 'DGI
QUIT
Begin DoDot:2
+19 IF $PIECE($GET(DGADD(22,DGI)),U,2)'=DGCAT
QUIT
+20 IF $PIECE($GET(DGADD(22,DGI)),U,3)'="Y"
QUIT
+21 SET DGRSLT=1
End DoDot:2
IF DGRSLT
QUIT
End DoDot:1
+22 ;
+23 QUIT DGRSLT
+24 ;
+25 ;
ISTEMP(DGADD) ;is temporary address active?
+1 ; This function determines if an active temporary address exists.
+2 ;
+3 ; Input:
+4 ; DGADD - address array in VADPT VAPA format
+5 ;
+6 ; Output:
+7 ; Function value - 1 on active temp address, 0 on failure
+8 ;
+9 QUIT $GET(DGADD(9))>0
+10 ;
+11 ;
ISFRGN(DGADD) ;is selected address foreign?
+1 ; This function determines if the address selected by VADPT is a
+2 ; foreign address.
+3 ;
+4 ; Input:
+5 ; DGADD - address aray in VADPT VAPA format
+6 ;
+7 ; Output:
+8 ; Function value - returns 1 on foreign address, 0 not a foreign
+9 ; address
+10 ;
+11 QUIT $GET(DGADD(7))="999"
+12 ;
+13 ;
GETABRV(DGIEN) ;retrieve state abbreviation
+1 ; This function retrieves the abbreviation for a state from the STAT
+2 ; (#5) file for a given IEN.
+3 ;
+4 ; Supported Reference:
+5 ; DBIA #10056: FileMan Read access to STATE (#5) file
+6 ;
+7 ; Input:
+8 ; DGIEN - pointer to a state in the STATE (#5) file
+9 ;
+10 ; Output:
+11 ; Function value - state abbreviation on success, "" on failure
+12 ;
+13 ;function value
NEW DGABRV
+14 ;FM error value
NEW DGERR
+15 ;
+16 SET DGABRV=""
+17 ;
+18 IF $GET(DGIEN)>0
IF $DATA(^DIC(5,DGIEN,0))
Begin DoDot:1
+19 SET DGABRV=$$GET1^DIQ(5,DGIEN_",",1,"","","DGERR")
+20 IF $DATA(DGERR)
SET DGABRV=""
End DoDot:1
+21 ;
+22 QUIT DGABRV
