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