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

BQIPTCPT.m

Go to the documentation of this file.
  1. BQIPTCPT ;VNGT/HS/ALA-Patient CPT data ; 10 Dec 2008 11:48 AM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. ;
  1. Q
  1. ;
  1. EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT CPTS
  1. ;
  1. ;Description - all the education that a patient has
  1. ;
  1. ;Input
  1. ; DFN - Patient internal entry number
  1. ;
  1. NEW UID,II,IEN
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPTCPT",UID))
  1. K @DATA
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTCPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S DRANGE=$$DATE^BQIUL1($G(DRANGE))
  1. S @DATA@(II)="I00010CPT_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050APCDTCPT^T00025APCDTM1^T00015APCDTM2^T00005APCDTUN"_$C(30)
  1. S IEN=""
  1. F S IEN=$O(^AUPNVCPT("AC",DFN,IEN),-1) Q:IEN="" D
  1. . S CPTN=$$GET1^DIQ(9000010.18,IEN_",",.01,"I") I CPTN="" Q
  1. . S CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
  1. . S VISIT=$$GET1^DIQ(9000010.18,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 MOD1=$$GET1^DIQ(9000010.18,IEN_",",.08,"E")
  1. . S MOD2=$$GET1^DIQ(9000010.18,IEN_",",.09,"E")
  1. . S QTY=$$GET1^DIQ(9000010.18,IEN_",",.16,"E")
  1. . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_CPT_U_MOD1_U_MOD2_U_QTY_$C(30)
  1. ;
  1. ; Check for refusals
  1. D REF
  1. ;
  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. REF ; Check for refusals
  1. NEW TOP,RVDT,REVDT,RFIEN,CPT,MOD1,MOD2,QTY,CPTN
  1. S TOP=""
  1. F S TOP=$O(^AUPNPREF("AA",DFN,81,TOP)) Q:TOP="" D
  1. . S RVDT=""
  1. . F S RVDT=$O(^AUPNPREF("AA",DFN,81,TOP,RVDT)) Q:RVDT="" D
  1. .. ; Reverse the reverse date
  1. .. S REVDT=9999999-RVDT
  1. .. I DRANGE'="",(REVDT\1)<DRANGE Q
  1. .. S RFIEN=""
  1. .. F S RFIEN=$O(^AUPNPREF("AA",DFN,81,TOP,RVDT,RFIEN)) Q:RFIEN="" D
  1. ... S CPTN=$$GET1^DIQ(9000022,RFIEN_",",.06,"I")
  1. ... S CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
  1. ... S RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
  1. ... S MOD2="",QTY=""
  1. ... S II=II+1,@DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_CPT_U_RSLT_U_MOD2_U_QTY_$C(30)
  1. Q