Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGGPOTH

AGGPOTH.m

Go to the documentation of this file. 
  1. AGGPOTH ;VNGT/HS/BEE-Other Patient Data Field Handling ; 02 May 2010  9:08 AM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  Q
  1.  ;
  1. UMIG(AGPATDFN,NSTS,NTYP) ;PEP - Update Migrant Worker Information
  1.  ;
  1.  ;Input:
  1.  ; AGPATDFN - Patient IEN
  1.  ; NSTS - New Migrant Status (Y/N)
  1.  ; NTYP - New Migrant Worker Type (M/S)
  1.  ;
  1.  ;Output:
  1.  ;Returns -1^Error Message - on Failure
  1.  ;        "" - on Success
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPOTH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  Q:AGPATDFN="" "-1^Missing Patient IEN"
  1.  ;
  1.  N AGG,DA,DIC,DLAYGO,ERROR,X,Y
  1.  ;
  1.  ;Define new entry and save
  1.  S DIC="^AUPNPAT("_AGPATDFN_",84,",DA(1)=AGPATDFN
  1.  S DIC(0)="L"
  1.  S X=DT
  1.  S DLAYGO="9000001.84",DIC("P")=DLAYGO
  1.  I '$D(^AUPNPAT(AGPATDFN,84,0)) S ^AUPNPAT(AGPATDFN,84,0)="^9000001.84D^^"
  1.  K DO,DD D FILE^DICN
  1.  ;
  1.  S DA=+Y,DA(1)=AGPATDFN
  1.  S AGG(9000001.84,DA_","_DA(1)_",",".02")=$S(NSTS'="":NSTS,1:"@")
  1.  S AGG(9000001.84,DA_","_DA(1)_",",".03")=$S(((NSTS="")!(NSTS="N")):"@",1:NTYP)
  1.  D FILE^DIE("","AGG","ERROR")
  1.  ;
  1.  I $D(ERROR) Q "-1^"_$G(ERROR)
  1.  ;
  1.  ;Successful Save
  1.  Q ""
  1.  ;
  1. RMIG(AGPATDFN) ;Return the patients most recent Migrant information
  1.  ;
  1.  N MDT,MDTX,MIEN,MSTS,MSTSX,MTYP,MTYPX,Y
  1.  ;
  1.  S (MDT,MDTX,MIEN,MSTS,MSTSX,MTYP,MTYPX)=""
  1.  S MDT=$O(^AUPNPAT(AGPATDFN,84,"B",""),-1)
  1.  I MDT]"" S MIEN=$O(^AUPNPAT(AGPATDFN,84,"B",MDT,""),-1)
  1.  S Y=MDT X ^DD("DD") S MDTX=Y
  1.  I MIEN]"" S MSTS=$$GET1^DIQ(9000001.84,MIEN_","_AGPATDFN_",",".02","I")
  1.  I MIEN]"" S MTYP=$$GET1^DIQ(9000001.84,MIEN_","_AGPATDFN_",",".03","I")
  1.  I MIEN]"" S MSTSX=$$GET1^DIQ(9000001.84,MIEN_","_AGPATDFN_",",".02","E")
  1.  I MIEN]"" S MTYPX=$$GET1^DIQ(9000001.84,MIEN_","_AGPATDFN_",",".03","E")
  1.  ;
  1.  Q MIEN_U_MDT_":"_MDTX_U_MSTS_":"_MSTSX_U_MTYP_":"_MTYPX
  1.  ;
  1.  ;
  1. UHOM(AGPATDFN,NSTS,NTYP) ;PEP - Update Homeless Information
  1.  ;
  1.  ;Input:
  1.  ; AGPATDFN - Patient IEN
  1.  ; NSTS - New Homeless Status (Y/N)
  1.  ; NTYP - New Homeless Type (H/T/D/S/U)
  1.  ;
  1.  ;Output:
  1.  ;Returns -1^Error Message - on Failure
  1.  ;        "" - on Success
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPOTH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  Q:AGPATDFN="" "-1^Missing Patient IEN"
  1.  ;
  1.  N AGG,DA,DIC,DLAYGO,ERROR,X,Y
  1.  ;
  1.  ;Define new entry and save
  1.  S DIC="^AUPNPAT("_AGPATDFN_",85,",DA(1)=AGPATDFN
  1.  S DIC(0)="L"
  1.  S X=DT
  1.  S DLAYGO="9000001.85",DIC("P")=DLAYGO
  1.  I '$D(^AUPNPAT(AGPATDFN,85,0)) S ^AUPNPAT(AGPATDFN,85,0)="^9000001.85D^^"
  1.  K DO,DD D FILE^DICN
  1.  ;
  1.  S DA=+Y,DA(1)=AGPATDFN
  1.  S AGG(9000001.85,DA_","_DA(1)_",",".02")=$S(NSTS'="":NSTS,1:"@")
  1.  S AGG(9000001.85,DA_","_DA(1)_",",".03")=$S(((NSTS="")!(NSTS="N")):"@",1:NTYP)
  1.  D FILE^DIE("","AGG","ERROR")
  1.  ;
  1.  I $D(ERROR) Q "-1^"_$G(ERROR)
  1.  ;
  1.  ;Successful Save
  1.  Q ""
  1.  ;
  1. RHOM(AGPATDFN) ;Return the patients most recent Homeless information
  1.  ;
  1.  N HDT,HDTX,HIEN,HSTS,HSTSX,HTYP,HTYPX,Y
  1.  ;
  1.  S (HDT,HDTX,HIEN,HSTS,HSTSX,HTYP,HTYPX)=""
  1.  S HDT=$O(^AUPNPAT(AGPATDFN,85,"B",""),-1)
  1.  I HDT]"" S HIEN=$O(^AUPNPAT(AGPATDFN,85,"B",HDT,""),-1)
  1.  S Y=HDT X ^DD("DD") S HDTX=Y
  1.  I HIEN]"" S HSTS=$$GET1^DIQ(9000001.85,HIEN_","_AGPATDFN_",",".02","I")
  1.  I HIEN]"" S HTYP=$$GET1^DIQ(9000001.85,HIEN_","_AGPATDFN_",",".03","I")
  1.  I HIEN]"" S HSTSX=$$GET1^DIQ(9000001.85,HIEN_","_AGPATDFN_",",".02","E")
  1.  I HIEN]"" S HTYPX=$$GET1^DIQ(9000001.85,HIEN_","_AGPATDFN_",",".03","E")
  1.  ;
  1.  Q HIEN_U_HDT_":"_HDTX_U_HSTS_":"_HSTSX_U_HTYP_":"_HTYPX
  1.  ;
  1.  ;
  1. UINT(AGPATDFN,AGGINTNT,OTHPARM) ;PEP - Update Internet Access Information
  1.  ;
  1.  ;Input:
  1.  ; AGPATDFN - Patient IEN
  1.  ; AGGINTNT - (1-YES/0-NO)
  1.  ; OTHPARM - OTHER_PARMS return value
  1.  ;
  1.  ;Output:
  1.  ;Returns -1^Error Message - on Failure
  1.  ;        "" - on Success
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPOTH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  Q:AGPATDFN="" "-1^Missing Patient IEN"
  1.  ;
  1.  N AGG,DA,DIC,DLAYGO,ERROR,X,Y,LIEN,LDT
  1.  ;
  1.  ;Pull existing entry IEN
  1.  S LIEN="",LDT=$O(^AUPNPAT(AGPATDFN,81,"B",""),-1)
  1.  I LDT]"" S LIEN=$O(^AUPNPAT(AGPATDFN,81,"B",LDT,""),-1)
  1.  ;
  1.  ;Define new entry and save
  1.  S DIC="^AUPNPAT("_AGPATDFN_",81,",DA(1)=AGPATDFN
  1.  S DIC(0)="L"
  1.  S X=DT
  1.  S DLAYGO="9000001.81",DIC("P")=DLAYGO
  1.  I '$D(^AUPNPAT(AGPATDFN,81,0)) S ^AUPNPAT(AGPATDFN,81,0)="^9000001.81D^^"
  1.  K DO,DD D FILE^DICN
  1.  ;
  1.  S DA=+Y,DA(1)=AGPATDFN
  1.  S OTHPARM=$G(OTHPARM)_$S($G(OTHPARM)'="":$C(28),1:"")_"AGGINT="_+Y
  1.  S AGG(9000001.81,DA_","_DA(1)_",",".02")=$S(AGGINTNT=0:0,AGGINTNT=1:1,1:"@")
  1.  D FILE^DIE("","AGG","ERROR")
  1.  ;
  1.  I LIEN]"" M ^AUPNPAT(AGPATDFN,81,DA,1)=^AUPNPAT(AGPATDFN,81,LIEN,1)
  1.  ;
  1.  I $D(ERROR) Q "-1^"_$G(ERROR)
  1.  ;
  1.  ;Successful Save
  1.  Q ""
  1.  ;
  1.  ;
  1. ULNG(AGPATDFN,NPRM,NINT,NEPR,NPRF,OTHPARM) ;PEP - Update Language Information
  1.  ;
  1.  ;Input:
  1.  ; AGPATDFN - Patient IEN
  1.  ; NPRM - Primary Patient Language IEN
  1.  ; NINT - Interpreter Required (Y/N/U)
  1.  ; NEPR - English Proficiency (VW/W/NW/NA)
  1.  ; NPRF - Preferred Patient Language IEN
  1.  ; OTHPARM - OTHER_PARMS return value
  1.  ;
  1.  ;Output:
  1.  ;Returns -1^Error Message - on Failure
  1.  ;        "" - on Success
  1.  ;        OTHPARM - Delimited parameter containing IEN of new language multiple
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPOTH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  Q:AGPATDFN="" "-1^Missing Patient IEN"
  1.  ;
  1.  N AGG,DA,DIC,DLAYGO,ERROR,X,Y,LDT,LIEN
  1.  ;
  1.  ;Pull existing entry IEN
  1.  S LIEN="",LDT=$O(^AUPNPAT(AGPATDFN,86,"B",""),-1)
  1.  I LDT]"" S LIEN=$O(^AUPNPAT(AGPATDFN,86,"B",LDT,""),-1)
  1.  ;
  1.  ;Define new entry and save
  1.  S DIC="^AUPNPAT("_AGPATDFN_",86,",DA(1)=AGPATDFN
  1.  S DIC(0)="L"
  1.  S X=DT
  1.  S DLAYGO="9000001.86",DIC("P")=DLAYGO
  1.  I '$D(^AUPNPAT(AGPATDFN,86,0)) S ^AUPNPAT(AGPATDFN,86,0)="^9000001.86D^^"
  1.  K DO,DD D FILE^DICN
  1.  ;
  1.  S DA=+Y,DA(1)=AGPATDFN
  1.  S OTHPARM=$G(OTHPARM)_$S($G(OTHPARM)'="":$C(28),1:"")_"AGGLNG="_+Y
  1.  I $G(NPRM)]"" S AGG(9000001.86,DA_","_DA(1)_",",".02")=NPRM
  1.  I $G(NINT)]"" S AGG(9000001.86,DA_","_DA(1)_",",".03")=NINT
  1.  I $G(NPRF)]"" S AGG(9000001.86,DA_","_DA(1)_",",".04")=NPRF
  1.  I $G(NEPR)]"" S AGG(9000001.86,DA_","_DA(1)_",",".06")=NEPR
  1.  I $D(AGG) D FILE^DIE("","AGG","ERROR")
  1.  ;
  1.  I LIEN]"" M ^AUPNPAT(AGPATDFN,86,DA,5)=^AUPNPAT(AGPATDFN,86,LIEN,5)  ;Save Existing Other Spoken Languages
  1.  ;
  1.  I $D(ERROR) Q "-1^"_$G(ERROR)_U_$G(OTHPARM)
  1.  ;
  1.  ;Successful Save
  1.  Q ""
  1.  ;
  1. UPD(DATA,DEF,AGPATDFN,MIEN,PROC,PARMS) ; EP - AGG UPDATE SPECIAL MULTIPLES
  1.  ; Input
  1.  ;   DEF   - Definition Name 'Other Languages'
  1.  ;   AGPATDFN - Patient DFN
  1.  ;   MIEN  - Multiple Level IEN value
  1.  ;   PROC  - 'A' to add, 'D' to delete
  1.  ;   PARMS - Parameters
  1.  ;
  1.  NEW UID,II,LIST,BN,AGGLGOTH,VFIEN,BQ,PDATA,NAME,VALUE,PFIEN,PTYP,CHIEN,RESULT,AGGINAM
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPOTH",UID))
  1.  S MIEN=$G(MIEN,"") S:MIEN=0 MIEN=""
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPOTH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)
  1.  . K PARMS
  1.  . S PARMS=LIST
  1.  . K LIST
  1.  ;
  1.  S AGGLGOTH="",AGGINAM=""
  1.  S VFIEN=$O(^AGG(9009068.3,"B",DEF,""))
  1.  I VFIEN="" S BMXSEC="RPC Call Failed: "_DEF_" Definition does not exist." Q
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . S PFIEN=$O(^AGG(9009068.3,VFIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S PTYP=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,1)),U,1)
  1.  . I PTYP="D" S VALUE=$$DATE^AGGUL1(VALUE)
  1.  . I PTYP="C" D
  1.  .. I VALUE="" Q
  1.  .. S CHIEN=$O(^AGG(9009068.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^AGG(9009068.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . S @NAME=VALUE
  1.  ;
  1.  S RESULT="-1^Unable to save multiple entry "_AGGLGOTH
  1.  ;
  1.  ;Process 'Other Languages' entries
  1.  I DEF="Other Languages" D
  1.  . ;
  1.  . ;Set up for Adds
  1.  . I $G(PROC)="A",$G(AGGLGOTH)]"" D  Q
  1.  .. N FDAIEN,FDA,ERROR
  1.  .. S FDAIEN(1)=AGGLGOTH
  1.  .. S FDA(1,9000001.8605,"+1,"_MIEN_","_AGPATDFN_",",.01)=AGGLGOTH
  1.  .. D UPDATE^DIE("","FDA(1)","FDAIEN","ERROR")
  1.  .. I $D(ERROR) S RESULT="-1^"_$G(ERROR("DIERR",1,"TEXT",1)) Q
  1.  .. S RESULT="1^"
  1.  .. ;
  1.  . ;Handle Deletes
  1.  . I $G(PROC)="D" D  Q
  1.  .. N DA,AGG,ERROR
  1.  .. S DA=+AGGLGOTH,DA(1)=MIEN,DA(2)=AGPATDFN
  1.  .. S AGG(9000001.8605,DA_","_DA(1)_","_DA(2)_",",.01)="@"
  1.  .. D FILE^DIE("","AGG","ERROR")
  1.  .. I $D(ERROR) S RESULT="-1^"_$G(ERROR("DIERR",1,"TEXT",1)) Q
  1.  .. S RESULT="1^"
  1.  ;
  1.  ;Process 'Internet Access Method' entries
  1.  I DEF="Internet Access Method" D
  1.  . ;
  1.  . ;Set up for Adds
  1.  . I $G(PROC)="A",$G(AGGINAM)]"" D  Q
  1.  .. N FDA,ERROR
  1.  .. S FDA(1,9000001.811,"+1,"_MIEN_","_AGPATDFN_",",.01)=AGGINAM
  1.  .. D UPDATE^DIE("","FDA(1)","","ERROR")
  1.  .. I $D(ERROR) S RESULT="-1^"_$G(ERROR("DIERR",1,"TEXT",1)) Q
  1.  .. S RESULT="1^"
  1.  . ;
  1.  . ;Handle Deletes
  1.  . I $G(PROC)="D" D  Q
  1.  .. N DA,AGG,ERROR
  1.  .. S DA=$O(^AUPNPAT(AGPATDFN,81,MIEN,1,"B",AGGINAM,"")) Q:DA=""
  1.  .. S DA(1)=MIEN,DA(2)=AGPATDFN
  1.  .. S AGG(9000001.811,DA_","_DA(1)_","_DA(2)_",",.01)="@"
  1.  .. D FILE^DIE("","AGG","ERROR")
  1.  .. I $D(ERROR) S RESULT="-1^"_$G(ERROR("DIERR",1,"TEXT",1)) Q
  1.  .. S RESULT="1^"
  1.  ;
  1. DONE     ;
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  ; Set last date updated and updated by
  1.  I $P(RESULT,U,1)=1 D
  1.  . S AGGDATAI(9000001,AGPATDFN_",",.03)=DT,AGGDATAI(9000001,AGPATDFN_",",.12)=DUZ
  1.  . D FILE^DIE("I","AGGDATAI","ERROR")
  1.  . D EDIT^AGGEXPRT(AGPATDFN)
  1.  Q
  1.  ;
  1. INTAM(DATA,DFN) ; EP - AGG PATIENT INT ACCESS METH
  1.  ;
  1.  NEW UID,II,AGIEN,ERROR,FILE,HEADR,DA,IDA,IEN,IENS
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPOTH",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPOTH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S AGIEN=$$FIND1^DIC(9009068.3,"","BX","Internet Access Method","","","ERROR")
  1.  I AGIEN=0 S BMXSEC="RPC Failed: Passed in window name "_DEF_" not found" Q
  1.  ;
  1.  S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,AGIEN,0),U,14)
  1.  ;
  1.  S DA(1)=DFN,IDA=$O(^AUPNPAT(DFN,81,"B"),-1) I IDA="" D  G XINTAM
  1.  . N HEADR
  1.  . S HEADR="T00050AGGINAM"
  1.  . S @DATA@(II)=HEADR_$C(30)
  1.  ;
  1.  I $O(^AUPNPAT(DFN,81,IDA,1,0))="" D  G XINTAM
  1.  . N HEADR
  1.  . S HEADR="T00050AGGINAM"
  1.  . S @DATA@(II)=HEADR_$C(30)
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^AUPNPAT(DFN,81,IDA,1,IEN)) Q:'IEN  D
  1.  . S DA(2)=DFN,DA(1)=IDA,DA=IEN
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . D REC(IENS,FILE,SECFILE)
  1.  ;
  1. XINTAM ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  Q
  1.  ;
  1. REC(IENS,FILE,SECFILE) ;EP
  1.  N AGCN,HEADR,HDATA,HDR,TXT
  1.  S HEADR="",HDATA=""
  1.  S AGCN=0
  1.  F  S AGCN=$O(^AGG(9009068.3,AGIEN,10,AGCN)) Q:'AGCN  D
  1.  . N AGDATA,FLD,TYPE,SECFLD,CODE,DEXEC,VAL,DQTY,FLD,VALUE
  1.  . I $P(^AGG(9009068.3,AGIEN,10,AGCN,0),U,11)'="" Q
  1.  . S AGDATA=$G(^AGG(9009068.3,AGIEN,10,AGCN,0))
  1.  . S FLD=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,1),SECFLD=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,7)
  1.  . S TYPE=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,1)),U,1)
  1.  . S CODE=$P(AGDATA,U,7),HDR=$P(AGDATA,U,2)
  1.  . S DEXEC=$G(^AGG(9009068.3,AGIEN,10,AGCN,8))
  1.  . I TYPE="M" S VALUE=""
  1.  . I TYPE="T"!(TYPE="C")!(TYPE="K") D
  1.  .. I DEXEC'="" D  Q
  1.  ... S VAL=""
  1.  ... I DEXEC'["DQTY" X DEXEC Q
  1.  ... S DQTY="I" X DEXEC S VAL=VALUE_$C(28)
  1.  ... S DQTY="E" X DEXEC S VALUE=VAL_VALUE
  1.  .. I FLD'="" S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"I")_$C(28)_$$GET1^DIQ(FILE,IENS,FLD,"E") Q
  1.  .. S VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"I")_$C(28)_$$GET1^DIQ(SECFILE,IENS,SECFLD,"E")
  1.  . I TYPE="X"!(TYPE="N") D
  1.  .. NEW TYPE
  1.  .. I DEXEC'="" X DEXEC Q
  1.  .. I FLD=.001 S VALUE=IEN Q
  1.  .. I FLD'="" S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"E") Q
  1.  .. S VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"E")
  1.  . I TYPE="D" D
  1.  .. I DEXEC'="" X DEXEC Q
  1.  .. I FLD'="" S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"I"),VALUE=$$FMTE^AGGUL1(VALUE) Q
  1.  .. S VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"I"),VALUE=$$FMTE^AGGUL1(VALUE)
  1.  . I TYPE="W" D
  1.  .. NEW FL,FD,AN
  1.  .. K ARRAY S VALUE=""
  1.  .. I DEXEC'="" X DEXEC
  1.  .. I DEXEC="" D
  1.  ... I FLD'="" D GETS^DIQ(FILE,DFN_",",FLD,"E","ARRAY") Q
  1.  ... D GETS^DIQ(SECFILE,DFN_",",SECFLD,"E","ARRAY")
  1.  .. S FL=$O(ARRAY("")) I FL="" Q
  1.  .. S FD=$O(ARRAY(FL,DFN_",","")) I FD="" Q
  1.  .. S AN=0,TXT=ARRAY(FL,DFN_",",FD,"E") I TXT="" Q
  1.  .. K @TXT@("E")
  1.  .. F  S AN=$O(@TXT@(AN)) Q:AN=""  S VALUE=VALUE_@TXT@(AN)_$C(10)
  1.  . S HEADR=HEADR_HDR_"^"
  1.  . S HDATA=HDATA_$G(VALUE)_"^",VALUE=""
  1.  S HEADR=$$TKO^AGGUL1(HEADR,"^"),HDATA=$$TKO^AGGUL1(HDATA,"^")
  1.  I II=0 S @DATA@(II)=HEADR_$C(30)
  1.  S II=II+1,@DATA@(II)=HDATA_$C(30)
  1.  ;
  1.  Q
  1.  ;
  1. DOTH(AGPATDFN) ;EP - Return the list of Other Languages Spoken
  1.  ;
  1.  N OTHL,LIEN,LDT,LNG,VAR
  1.  ;
  1.  I AGPATDFN="" Q ""  ;Missing patient DFN
  1.  ;
  1.  S OTHL=""
  1.  ;
  1.  ;Pull existing entry IEN
  1.  S LIEN="",LDT=$O(^AUPNPAT(AGPATDFN,86,"B",""),-1)
  1.  I LDT]"" S LIEN=$O(^AUPNPAT(AGPATDFN,86,"B",LDT,""),-1)
  1.  ;
  1.  I LIEN="" Q ""  ;No Language Information on File
  1.  ;
  1.  ;Pull Other Languages
  1.  D GETS^DIQ(9000001.86,LIEN_","_AGPATDFN_",",".05*","E","VAR")
  1.  ;
  1.  S IEN="" F  S IEN=$O(VAR(9000001.8605,IEN)) Q:IEN=""  S LNG=$G(VAR(9000001.8605,IEN,".01","E")) I LNG]"" S OTHL=OTHL_$S(OTHL="":"",1:", ")_LNG I OTHL[", " S OTHL="MORE THAN ONE LANGUAGE" Q
  1.  Q OTHL
  1.  ;
  1. DINTW(AGPATDFN) ;EP - Return the list of Internet WHERE values
  1.  ;
  1.  N INTW,LIEN,LDT,WHERE,VAR,IEN
  1.  ;
  1.  I AGPATDFN="" Q ""  ;Missing patient DFN
  1.  ;
  1.  S INTW=""
  1.  ;
  1.  ;Pull existing entry IEN
  1.  S LIEN="",LDT=$O(^AUPNPAT(AGPATDFN,81,"B",""),-1)
  1.  I LDT]"" S LIEN=$O(^AUPNPAT(AGPATDFN,81,"B",LDT,""),-1)
  1.  ;
  1.  I LIEN="" Q ""  ;No Internet Information on File
  1.  ;
  1.  ;Pull Internet WHERE values
  1.  D GETS^DIQ(9000001.81,LIEN_","_AGPATDFN_",",".04*","I","VAR")
  1.  ;
  1.  S IEN="" F  S IEN=$O(VAR(9000001.811,IEN)) Q:IEN=""  S WHERE=$G(VAR(9000001.811,IEN,".01","I")) I WHERE]"" S INTW=INTW_$S(INTW="":"",1:", ")_WHERE
  1.  Q INTW
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q