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

BQIPTHF.m

Go to the documentation of this file.
  1. BQIPTHF ;PRXM/HC/ALA - PATIENT HEALTH FACTORS ; 26 Mar 2007 3:21 PM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. ;
  1. Q
  1. ;
  1. HF(DATA,DFN,DRANGE) ; EP -- BQI PATIENT HEALTH FACTORS
  1. ;
  1. ;Description - all the health factors that a patient has
  1. ;
  1. ;Input
  1. ; DFN - Patient internal entry number
  1. ;
  1. NEW UID,II,IEN,HF,VISIT,VSDTM,PROV,ORPHY,ENPHY,LEVEL,QTY,COMMENT,HFN,CAT
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPTHF",UID))
  1. K @DATA
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTHF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S DRANGE=$$DATE^BQIUL1($G(DRANGE))
  1. S @DATA@(II)="I00010HF_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00040HF_CATEGORY^T00040HEALTH_FACTOR^T00020LEVEL^N00010QTY^T00035PROVIDER^T00245COMMENT"_$C(30)
  1. S IEN=""
  1. F S IEN=$O(^AUPNVHF("AC",DFN,IEN),-1) Q:IEN="" D
  1. . S HF=$$GET1^DIQ(9000010.23,IEN_",",.01,"E") I HF="" Q
  1. . S HFN=$$GET1^DIQ(9000010.23,IEN_",",.01,"I")
  1. . S VISIT=$$GET1^DIQ(9000010.23,IEN_",",.03,"I") I VISIT="" Q
  1. . S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSDTM=0 Q
  1. . I DRANGE'="",(VSDTM\1<DRANGE) Q
  1. . S LEVEL=$$GET1^DIQ(9000010.23,IEN_",",.04,"E")
  1. . S PROV=$$GET1^DIQ(9000010.23,IEN_",",.05,"E")
  1. . S QTY=$$GET1^DIQ(9000010.23,IEN_",",.06,"E") S:QTY="" QTY="-1"
  1. . S COMMENT=$$GET1^DIQ(9000010.23,IEN_",",81101,"E")
  1. . S CAT=$$GET1^DIQ(9999999.64,HFN_",",.03,"E")
  1. . ;S ORPHY=$$GET1^DIQ(9000010.23,IEN_",",1202,"E")
  1. . ;S ENPHY=$$GET1^DIQ(9000010.23,IEN_",",1204,"E")
  1. . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_CAT_U_HF_U_LEVEL_U_QTY_U_PROV_U_COMMENT_$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