DGQEDEMO ;ALB/RPM - VIC REPLACEMENT DEMOGRAPHICS GETTER API'S ; 9/19/03
;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
;
; This routine contains the following patient demographic data
; retrieval procedures and functions:
; $$GETICN - retrieves patient's national ICN
; $$GETIDS - retrieves patient identifiers
; $$GETNAMEC - retrieves patient's name components
; $$GETADDR - retrieves patient's mailing address
; GETSITE - retrieves local station name and number
;
Q ;no direct entry
;
GETICN(DGDFN) ;retrieve patient national ICN
; This function retrieves the ICN for a patient if the ICN is
; nationally assigned.
;
; Supported References:
; DBIA #2701: $$GETICN^MPIF001, $$IFLOCAL^MPIF001
;
; Input:
; DGDFN - (required) pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - returns National ICN on success, 0 on failure
;
N DGICN
;
S DGICN=0
I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
. ;
. S DGICN=$$GETICN^MPIF001(DGDFN)
. S DGICN=$S(DGICN>0:$P(DGICN,"V",1),1:0)
. Q:'DGICN
. ;
. I $$IFLOCAL^MPIF001(DGDFN) S DGICN=0
;
Q DGICN
;
;
GETIDS(DGDFN,DGIDS) ;retrieve patient identifiers
; This function retrieves identifying information for a patient
; in the PATIENT (#2) file and places it in an array format.
;
; Supported Reference:
; DBIA #10035: Direct global reference of patient's zero
; node in the PATIENT (#2) file
;
; Input:
; DGDFN - (required) ien of patient in PATIENT (#2) file
;
; Output:
; Function value - returns 1 on success, 0 on failure
; DGIDS - output array containing the patient identifying information,
; on success, pass by reference.
; Array subscripts are:
; "DFN" - ien PATIENT (#2) file
; "NAME" - patient name
; "SEX" - patient gender ("M"/"F")
; "SSN" - patient Social Security Number
; "DOB" - patient date of birth (FM format)
;
N DGNODE
N DGRSLT
;
S DGRSLT=0
;
I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
.
. ;get zero node of patient record
. S DGNODE=$G(^DPT(DGDFN,0))
. ;
. S DGIDS("DFN")=DGDFN
. S DGIDS("NAME")=$P(DGNODE,U)
. S DGIDS("SEX")=$P(DGNODE,U,2)
. S DGIDS("DOB")=$P(DGNODE,U,3)
. S DGIDS("SSN")=$P(DGNODE,U,9)
. S DGRSLT=1 ;success
;
Q DGRSLT
;
;
GETNAMC(DGDFN,DGCOMP) ;retrieve name components
; This function retrieves a given patient's name components from the
; NAME COMPONENT (#20) file and places the components in an array
; format. The supported API $$HLNAME^XLFNAME is used to retrieve the
; name components, since it is the only supported Name Standardization
; api that both reads from the NAME COMPONENT (#20) file and returns a
; result that can be easily parsed.
;
; Supported Reference:
; DBIA #3065: $$HLNAME^XLFNAME
;
; Input:
; DGDFN - (required) pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - returns 1 on success, 0 on failure
; DGCOMP - name component array on success, pass by reference
; Array subscripts are:
; "LAST" - Family (last) name
; "FIRST" - Given (first) name
; "MIDDLE" - Middle name
; "SUFFIX" - Name suffix
; "PREFIX" - Name prefix
;
N DGSUB ;component array subscripts
N DGFLD ;component field position
N DGNAMSTR ;XLFNAME name component string
N DGPAR ;XLFNAME input parameter array
N DGRSLT ;function value
;
S DGRSLT=0
;
I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
. S DGFLD=0
. S DGPAR("FILE")=2,DGPAR("FIELD")=".01",DGPAR("IENS")=DGDFN_","
. S DGNAMSTR=$$HLNAME^XLFNAME(.DGPAR,,U)
. F DGSUB="LAST","FIRST","MIDDLE","SUFFIX","PREFIX" D
. . S DGFLD=DGFLD+1
. . S DGCOMP(DGSUB)=$P(DGNAMSTR,U,DGFLD)
. S DGRSLT=1 ;success
;
Q DGRSLT
;
;
GETADDR(DGDFN,DGMADR,DGAERR) ;retrieve patient mailing address
; This funtion selects the mailing address for a patient from the
; available HIPAA confidential address, temporary address, permanent
; address. If the BAD ADDRESS INDICATOR (#.121) of the PATIENT file
; is set, then the facility address will be selected. The selected
; address is placed in an array format.
;
; Supported Reference:
; DBIA #4080: $$BADADR^DGUTL3
;
; Input:
; DGDFN - (required) pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - returns 1 on success, 0 on failure
; DGMADR - array of mailing address fields on success, pass by
; reference
; Array subscripts are:
; "STREET1" - line 1 of street address
; "STREET2" - line 2 of street address
; "STREET3" - line 3 of street address
; "CITY" - city
; "STATE" - state
; "ZIP" - zip code
; "ADRTYPE" - address type
; [1:perm.; 2:temp.; 3:conf.; 4:facility]
; DGAERR - error message text defined on failure, pass by reference
;
N DGADDR ;address array in ADD^VAPDT format
N DGRSLT ;function value
N DGTYPE ;address type
;
S DGRSLT=0
S DGTYPE=0
;
I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D ;exit block on first error
. ;
. ;select between permanent, temporary and confidential addresses
. S DGTYPE=$$GETPTCA^DGQEUT3(DGDFN,.DGADDR)
. ;
. ;get facility address when no address, foreign address, or
. ;bad address indicator is set
. I 'DGTYPE!($$ISFRGN^DGQEUT3(.DGADDR))!(+$$BADADR^DGUTL3(DGDFN)>0) D
. . S DGTYPE=4 ;facility address
. . I '$$GETFADD^DGQEUT3(.DGADDR) D
. . . S DGAERR="Unable to retrieve facility address."
. Q:$D(DGAERR)
. ;
. ;load mailing address array with retrieved address
. S DGMADR("STREET1")=$G(DGADDR(1))
. S DGMADR("STREET2")=$G(DGADDR(2))
. S DGMADR("STREET3")=$G(DGADDR(3))
. S DGMADR("CITY")=$G(DGADDR(4))
. S DGMADR("STATE")=$G(DGADDR(5))
. S DGMADR("ZIP")=$G(DGADDR(6))
. S DGMADR("ADRTYPE")=DGTYPE
. S DGRSLT=1 ;success
;
Q DGRSLT
;
;
GETSITE(DGFAC) ;retrieve the local site station number and name
; This procedure retrieves the local site's name and station number
; and places them in an array format. A valid DUZ(2) is used to
; determine the station number and name. $$SITE^VASITE() is used
; when DUZ(2) is undefined or invalid.
;
; Supported References:
; DBIA #2171: $$STA^XUAF4, $$NAME^XUAF4
; DBIA #10112: $$SITE^VASITE
;
; Input:
; none
;
; Output:
; DGFAC - array of facility information
; Array subscripts are:
; "FACNUM" - station number
; "FACNAME" - facility name
;
N DGERR
N DGIEN
N DGINST ;pointer to INSTITUTION (#4) file
;
I $G(DUZ(2))>0,$D(^DIC(4,DUZ(2))) D
. S DGINST=DUZ(2)
E D
. S DGINST=$P($$SITE^VASITE(),U)
;
S DGFAC("FACNUM")=$$STA^XUAF4(DGINST)
S DGFAC("FACNAME")=$$NAME^XUAF4(DGINST)
S DGFAC("VISN")=$$GETVISN(DGINST)
;
Q
;
GETVISN(DGINST) ;retrieve VISN for an institution
; This function checks for a "VISN" entry in the ASSOCIATIONS
; (#14) multiple field in the INSTITUTION (#4) file for a given
; institution. If a "VISN" entry exists, then the PARENT OF ASSOCIATION
; (#1) subfield value is returned.
;
; DBIA: #10090 - Read entire INSTITUTION (#4) file with FileMan
;
; Input:
; DGINST - pointer to INSTITUTION (#4) file
;
; Output:
; Function value - VISN name on success, "" on failure
;
N DGERR ;FM error array
N DGVISN ;function value
;
S DGVISN=""
I $G(DGINST),$D(^DIC(4,DGINST)) D
. S DGIEN=$$FIND1^DIC(4.014,","_DGINST_",","","VISN","B","","DGERR")
. Q:('DGIEN!($D(DGERR)))
. ;
. S DGVISN=$$GET1^DIQ(4.014,DGIEN_","_DGINST_",",1,"E","","DGERR")
;
Q DGVISN
DGQEDEMO ;ALB/RPM - VIC REPLACEMENT DEMOGRAPHICS GETTER API'S ; 9/19/03
+1 ;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; This routine contains the following patient demographic data
+4 ; retrieval procedures and functions:
+5 ; $$GETICN - retrieves patient's national ICN
+6 ; $$GETIDS - retrieves patient identifiers
+7 ; $$GETNAMEC - retrieves patient's name components
+8 ; $$GETADDR - retrieves patient's mailing address
+9 ; GETSITE - retrieves local station name and number
+10 ;
+11 ;no direct entry
QUIT
+12 ;
GETICN(DGDFN) ;retrieve patient national ICN
+1 ; This function retrieves the ICN for a patient if the ICN is
+2 ; nationally assigned.
+3 ;
+4 ; Supported References:
+5 ; DBIA #2701: $$GETICN^MPIF001, $$IFLOCAL^MPIF001
+6 ;
+7 ; Input:
+8 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
+9 ;
+10 ; Output:
+11 ; Function value - returns National ICN on success, 0 on failure
+12 ;
+13 NEW DGICN
+14 ;
+15 SET DGICN=0
+16 IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+17 ;
+18 SET DGICN=$$GETICN^MPIF001(DGDFN)
+19 SET DGICN=$SELECT(DGICN>0:$PIECE(DGICN,"V",1),1:0)
+20 IF 'DGICN
QUIT
+21 ;
+22 IF $$IFLOCAL^MPIF001(DGDFN)
SET DGICN=0
End DoDot:1
+23 ;
+24 QUIT DGICN
+25 ;
+26 ;
GETIDS(DGDFN,DGIDS) ;retrieve patient identifiers
+1 ; This function retrieves identifying information for a patient
+2 ; in the PATIENT (#2) file and places it in an array format.
+3 ;
+4 ; Supported Reference:
+5 ; DBIA #10035: Direct global reference of patient's zero
+6 ; node in the PATIENT (#2) file
+7 ;
+8 ; Input:
+9 ; DGDFN - (required) ien of patient in PATIENT (#2) file
+10 ;
+11 ; Output:
+12 ; Function value - returns 1 on success, 0 on failure
+13 ; DGIDS - output array containing the patient identifying information,
+14 ; on success, pass by reference.
+15 ; Array subscripts are:
+16 ; "DFN" - ien PATIENT (#2) file
+17 ; "NAME" - patient name
+18 ; "SEX" - patient gender ("M"/"F")
+19 ; "SSN" - patient Social Security Number
+20 ; "DOB" - patient date of birth (FM format)
+21 ;
+22 NEW DGNODE
+23 NEW DGRSLT
+24 ;
+25 SET DGRSLT=0
+26 ;
+27 IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+28 +29 ;get zero node of patient record
+30 SET DGNODE=$GET(^DPT(DGDFN,0))
+31 ;
+32 SET DGIDS("DFN")=DGDFN
+33 SET DGIDS("NAME")=$PIECE(DGNODE,U)
+34 SET DGIDS("SEX")=$PIECE(DGNODE,U,2)
+35 SET DGIDS("DOB")=$PIECE(DGNODE,U,3)
+36 SET DGIDS("SSN")=$PIECE(DGNODE,U,9)
+37 ;success
SET DGRSLT=1
End DoDot:1
+38 ;
+39 QUIT DGRSLT
+40 ;
+41 ;
GETNAMC(DGDFN,DGCOMP) ;retrieve name components
+1 ; This function retrieves a given patient's name components from the
+2 ; NAME COMPONENT (#20) file and places the components in an array
+3 ; format. The supported API $$HLNAME^XLFNAME is used to retrieve the
+4 ; name components, since it is the only supported Name Standardization
+5 ; api that both reads from the NAME COMPONENT (#20) file and returns a
+6 ; result that can be easily parsed.
+7 ;
+8 ; Supported Reference:
+9 ; DBIA #3065: $$HLNAME^XLFNAME
+10 ;
+11 ; Input:
+12 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
+13 ;
+14 ; Output:
+15 ; Function value - returns 1 on success, 0 on failure
+16 ; DGCOMP - name component array on success, pass by reference
+17 ; Array subscripts are:
+18 ; "LAST" - Family (last) name
+19 ; "FIRST" - Given (first) name
+20 ; "MIDDLE" - Middle name
+21 ; "SUFFIX" - Name suffix
+22 ; "PREFIX" - Name prefix
+23 ;
+24 ;component array subscripts
NEW DGSUB
+25 ;component field position
NEW DGFLD
+26 ;XLFNAME name component string
NEW DGNAMSTR
+27 ;XLFNAME input parameter array
NEW DGPAR
+28 ;function value
NEW DGRSLT
+29 ;
+30 SET DGRSLT=0
+31 ;
+32 IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+33 SET DGFLD=0
+34 SET DGPAR("FILE")=2
SET DGPAR("FIELD")=".01"
SET DGPAR("IENS")=DGDFN_","
+35 SET DGNAMSTR=$$HLNAME^XLFNAME(.DGPAR,,U)
+36 FOR DGSUB="LAST","FIRST","MIDDLE","SUFFIX","PREFIX"
Begin DoDot:2
+37 SET DGFLD=DGFLD+1
+38 SET DGCOMP(DGSUB)=$PIECE(DGNAMSTR,U,DGFLD)
End DoDot:2
+39 ;success
SET DGRSLT=1
End DoDot:1
+40 ;
+41 QUIT DGRSLT
+42 ;
+43 ;
GETADDR(DGDFN,DGMADR,DGAERR) ;retrieve patient mailing address
+1 ; This funtion selects the mailing address for a patient from the
+2 ; available HIPAA confidential address, temporary address, permanent
+3 ; address. If the BAD ADDRESS INDICATOR (#.121) of the PATIENT file
+4 ; is set, then the facility address will be selected. The selected
+5 ; address is placed in an array format.
+6 ;
+7 ; Supported Reference:
+8 ; DBIA #4080: $$BADADR^DGUTL3
+9 ;
+10 ; Input:
+11 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
+12 ;
+13 ; Output:
+14 ; Function value - returns 1 on success, 0 on failure
+15 ; DGMADR - array of mailing address fields on success, pass by
+16 ; reference
+17 ; Array subscripts are:
+18 ; "STREET1" - line 1 of street address
+19 ; "STREET2" - line 2 of street address
+20 ; "STREET3" - line 3 of street address
+21 ; "CITY" - city
+22 ; "STATE" - state
+23 ; "ZIP" - zip code
+24 ; "ADRTYPE" - address type
+25 ; [1:perm.; 2:temp.; 3:conf.; 4:facility]
+26 ; DGAERR - error message text defined on failure, pass by reference
+27 ;
+28 ;address array in ADD^VAPDT format
NEW DGADDR
+29 ;function value
NEW DGRSLT
+30 ;address type
NEW DGTYPE
+31 ;
+32 SET DGRSLT=0
+33 SET DGTYPE=0
+34 ;
+35 ;exit block on first error
IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+36 ;
+37 ;select between permanent, temporary and confidential addresses
+38 SET DGTYPE=$$GETPTCA^DGQEUT3(DGDFN,.DGADDR)
+39 ;
+40 ;get facility address when no address, foreign address, or
+41 ;bad address indicator is set
+42 IF 'DGTYPE!($$ISFRGN^DGQEUT3(.DGADDR))!(+$$BADADR^DGUTL3(DGDFN)>0)
Begin DoDot:2
+43 ;facility address
SET DGTYPE=4
+44 IF '$$GETFADD^DGQEUT3(.DGADDR)
Begin DoDot:3
+45 SET DGAERR="Unable to retrieve facility address."
End DoDot:3
End DoDot:2
+46 IF $DATA(DGAERR)
QUIT
+47 ;
+48 ;load mailing address array with retrieved address
+49 SET DGMADR("STREET1")=$GET(DGADDR(1))
+50 SET DGMADR("STREET2")=$GET(DGADDR(2))
+51 SET DGMADR("STREET3")=$GET(DGADDR(3))
+52 SET DGMADR("CITY")=$GET(DGADDR(4))
+53 SET DGMADR("STATE")=$GET(DGADDR(5))
+54 SET DGMADR("ZIP")=$GET(DGADDR(6))
+55 SET DGMADR("ADRTYPE")=DGTYPE
+56 ;success
SET DGRSLT=1
End DoDot:1
+57 ;
+58 QUIT DGRSLT
+59 ;
+60 ;
GETSITE(DGFAC) ;retrieve the local site station number and name
+1 ; This procedure retrieves the local site's name and station number
+2 ; and places them in an array format. A valid DUZ(2) is used to
+3 ; determine the station number and name. $$SITE^VASITE() is used
+4 ; when DUZ(2) is undefined or invalid.
+5 ;
+6 ; Supported References:
+7 ; DBIA #2171: $$STA^XUAF4, $$NAME^XUAF4
+8 ; DBIA #10112: $$SITE^VASITE
+9 ;
+10 ; Input:
+11 ; none
+12 ;
+13 ; Output:
+14 ; DGFAC - array of facility information
+15 ; Array subscripts are:
+16 ; "FACNUM" - station number
+17 ; "FACNAME" - facility name
+18 ;
+19 NEW DGERR
+20 NEW DGIEN
+21 ;pointer to INSTITUTION (#4) file
NEW DGINST
+22 ;
+23 IF $GET(DUZ(2))>0
IF $DATA(^DIC(4,DUZ(2)))
Begin DoDot:1
+24 SET DGINST=DUZ(2)
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 SET DGINST=$PIECE($$SITE^VASITE(),U)
End DoDot:1
+27 ;
+28 SET DGFAC("FACNUM")=$$STA^XUAF4(DGINST)
+29 SET DGFAC("FACNAME")=$$NAME^XUAF4(DGINST)
+30 SET DGFAC("VISN")=$$GETVISN(DGINST)
+31 ;
+32 QUIT
+33 ;
GETVISN(DGINST) ;retrieve VISN for an institution
+1 ; This function checks for a "VISN" entry in the ASSOCIATIONS
+2 ; (#14) multiple field in the INSTITUTION (#4) file for a given
+3 ; institution. If a "VISN" entry exists, then the PARENT OF ASSOCIATION
+4 ; (#1) subfield value is returned.
+5 ;
+6 ; DBIA: #10090 - Read entire INSTITUTION (#4) file with FileMan
+7 ;
+8 ; Input:
+9 ; DGINST - pointer to INSTITUTION (#4) file
+10 ;
+11 ; Output:
+12 ; Function value - VISN name on success, "" on failure
+13 ;
+14 ;FM error array
NEW DGERR
+15 ;function value
NEW DGVISN
+16 ;
+17 SET DGVISN=""
+18 IF $GET(DGINST)
IF $DATA(^DIC(4,DGINST))
Begin DoDot:1
+19 SET DGIEN=$$FIND1^DIC(4.014,","_DGINST_",","","VISN","B","","DGERR")
+20 IF ('DGIEN!($DATA(DGERR)))
QUIT
+21 ;
+22 SET DGVISN=$$GET1^DIQ(4.014,DGIEN_","_DGINST_",",1,"E","","DGERR")
End DoDot:1
+23 ;
+24 QUIT DGVISN
