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

BQIPTDDG.m

Go to the documentation of this file. 
  1. BQIPTDDG ;APTIV/HC/ALA-Patient Detail Demographics ; 03 Mar 2008  1:32 PM
  1.  ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,DFN) ; EP -- BQI PATIENT DETAIL DEMOG
  1.  ; 
  1.  ; Input
  1.  ;  DFN    - Patients DFN or internal entry number
  1.  ;
  1.  NEW UID,II,HDR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTDDG",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTDDG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00015MARITAL_STATUS^T00030CLASS^T00012ENROLL_NO^T00042TRIBE^T00030TRIBE_QUANTUM^T00030INDIAN_BLOOD^"
  1.  ;
  1.  NEW MSTAT,CLASS,ENROLL,TRIBE,TQUANT,IQUANT,RETURN,POBC,POBS,POB,DLEN,LENGTH
  1.  NEW RACE,BN,ETHN,OTRIB,IEN,POBSI,HMLOC
  1.  S IEN=DFN_","
  1.  S MSTAT=$$GET1^DIQ(2,IEN,.05,"E")
  1.  S CLASS=$$GET1^DIQ(9000001,IEN,1111,"E")
  1.  S ENROLL=$$GET1^DIQ(9000001,IEN,.07,"E")
  1.  S TRIBE=$$GET1^DIQ(9000001,IEN,1108,"E")
  1.  S TQUANT=$$GET1^DIQ(9000001,IEN,1109,"E")
  1.  S IQUANT=$$GET1^DIQ(9000001,IEN,1110,"E")
  1.  S RETURN=MSTAT_U_CLASS_U_ENROLL_U_TRIBE_U_TQUANT_U_IQUANT_U
  1.  S POBC=$$GET1^DIQ(2,IEN,.092,"E"),POBS=""
  1.  ;S POBSI=$$GET1^DIQ(2,IEN,.093,"I") I POBSI'="" S POBS=$$GET1^DIQ(5,IEN,1,"E")
  1.  S POBS=$$GET1^DIQ(5,$$GET1^DIQ(2,IEN,.093,"I"),1,"E")
  1.  S POB=POBC_" "_POBS,LENGTH=$L(POB),DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
  1.  S HDR=HDR_"T"_DLEN_"PLACE_OF_BIRTH"_U,RETURN=RETURN_POB_U
  1.  ;
  1.  S BN=0,RACE=""
  1.  F  S BN=$O(^DPT(DFN,.02,BN)) Q:'BN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
  1.  . S RACE=RACE_$$GET1^DIQ(2.02,IENS,.01,"E")_";"
  1.  S RACE=$$TKO^BQIUL1(RACE,";"),LENGTH=$L(RACE)
  1.  S:LENGTH=""!(LENGTH=0) LENGTH=45
  1.  S DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
  1.  S HDR=HDR_"T"_DLEN_"RACE"_U,RETURN=RETURN_RACE_U
  1.  ;
  1.  S BN=0,ETHN=""
  1.  F  S BN=$O(^DPT(DFN,.06,BN)) Q:'BN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
  1.  . S ETHN=ETHN_$$GET1^DIQ(2.06,IENS,.01,"E")_";"
  1.  S ETHN=$$TKO^BQIUL1(ETHN,";"),LENGTH=$L(ETHN)
  1.  S:LENGTH=""!(LENGTH=0) LENGTH=30
  1.  S DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
  1.  S HDR=HDR_"T"_DLEN_"ETHNICITY"_U,RETURN=RETURN_ETHN_U
  1.  ;
  1.  S BN=0,OTRIB=""
  1.  F  S BN=$O(^AUPNPAT(DFN,43,BN)) Q:'BN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
  1.  . S OTRIB=OTRIB_$$GET1^DIQ(9000001.43,IENS,.01,"E")_";"
  1.  S OTRIB=$$TKO^BQIUL1(OTRIB,";"),LENGTH=$L(OTRIB)
  1.  S:LENGTH=""!(LENGTH=0) LENGTH=42
  1.  S DLEN=$E("00000",$L(LENGTH)+1,5)_(LENGTH+1)
  1.  S HDR=HDR_"T"_DLEN_"OTHER_TRIBES"_U,RETURN=RETURN_OTRIB_U
  1.  ;
  1.  ;Location of Home
  1.  S HMLOC=$$HMLOC(DFN)
  1.  S HDR=HDR_"T01024HMLOC",RETURN=RETURN_HMLOC
  1.  ;
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S II=II+1,@DATA@(II)=RETURN_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  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
  1.  ;
  1. HMLOC(DFN) ;EP - Return Patient Location of Home Value (Panel View field HMLOC)
  1.  ;
  1.  N IEN,LIEN,HMLOC,FLDS,GDDATA
  1.  S IEN=DFN_","
  1.  S FLDS="1201"
  1.  D GETS^DIQ(9000001,IEN,FLDS,"E","GDDATA")
  1.  ;
  1.  ;Patient Location
  1.  S (HMLOC,LIEN)="" F  S LIEN=$O(GDDATA(9000001,IEN,1201,LIEN)) Q:'LIEN  D
  1.  . S HMLOC=$G(HMLOC)_$S($G(HMLOC)]"":" ",1:"")_$G(GDDATA(9000001,IEN,1201,LIEN))
  1.  K LIEN
  1.  ;
  1.  Q HMLOC