BQIPTCPT ;VNGT/HS/ALA-Patient CPT data ; 10 Dec 2008 11:48 AM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT CPTS
;
;Description - all the education that a patient has
;
;Input
; DFN - Patient internal entry number
;
NEW UID,II,IEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTCPT",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTCPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S DRANGE=$$DATE^BQIUL1($G(DRANGE))
S @DATA@(II)="I00010CPT_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050APCDTCPT^T00025APCDTM1^T00015APCDTM2^T00005APCDTUN"_$C(30)
S IEN=""
F S IEN=$O(^AUPNVCPT("AC",DFN,IEN),-1) Q:IEN="" D
. S CPTN=$$GET1^DIQ(9000010.18,IEN_",",.01,"I") I CPTN="" Q
. S CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
. S VISIT=$$GET1^DIQ(9000010.18,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 MOD1=$$GET1^DIQ(9000010.18,IEN_",",.08,"E")
. S MOD2=$$GET1^DIQ(9000010.18,IEN_",",.09,"E")
. S QTY=$$GET1^DIQ(9000010.18,IEN_",",.16,"E")
. S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_CPT_U_MOD1_U_MOD2_U_QTY_$C(30)
;
; Check for refusals
D REF
;
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
;
REF ; Check for refusals
NEW TOP,RVDT,REVDT,RFIEN,CPT,MOD1,MOD2,QTY,CPTN
S TOP=""
F S TOP=$O(^AUPNPREF("AA",DFN,81,TOP)) Q:TOP="" D
. S RVDT=""
. F S RVDT=$O(^AUPNPREF("AA",DFN,81,TOP,RVDT)) Q:RVDT="" D
.. ; Reverse the reverse date
.. S REVDT=9999999-RVDT
.. I DRANGE'="",(REVDT\1)<DRANGE Q
.. S RFIEN=""
.. F S RFIEN=$O(^AUPNPREF("AA",DFN,81,TOP,RVDT,RFIEN)) Q:RFIEN="" D
... S CPTN=$$GET1^DIQ(9000022,RFIEN_",",.06,"I")
... S CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
... S RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
... S MOD2="",QTY=""
... S II=II+1,@DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_CPT_U_RSLT_U_MOD2_U_QTY_$C(30)
Q
BQIPTCPT ;VNGT/HS/ALA-Patient CPT data ; 10 Dec 2008 11:48 AM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT CPTS
+1 ;
+2 ;Description - all the education that a patient has
+3 ;
+4 ;Input
+5 ; DFN - Patient internal entry number
+6 ;
+7 NEW UID,II,IEN
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQIPTCPT",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTCPT D UNWIND^%ZTER"
+14 ;
+15 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
+16 SET @DATA@(II)="I00010CPT_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050APCDTCPT^T00025APCDTM1^T00015APCDTM2^T00005APCDTUN"_$CHAR(30)
+17 SET IEN=""
+18 FOR
SET IEN=$ORDER(^AUPNVCPT("AC",DFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+19 SET CPTN=$$GET1^DIQ(9000010.18,IEN_",",.01,"I")
IF CPTN=""
QUIT
+20 SET CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
+21 SET VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I")
IF VISIT=""
QUIT
+22 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSDTM=0
QUIT
+23 IF DRANGE'=""
IF (VSDTM\1<DRANGE)
QUIT
+24 SET MOD1=$$GET1^DIQ(9000010.18,IEN_",",.08,"E")
+25 SET MOD2=$$GET1^DIQ(9000010.18,IEN_",",.09,"E")
+26 SET QTY=$$GET1^DIQ(9000010.18,IEN_",",.16,"E")
+27 SET II=II+1
SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_CPT_U_MOD1_U_MOD2_U_QTY_$CHAR(30)
End DoDot:1
+28 ;
+29 ; Check for refusals
+30 DO REF
+31 ;
+32 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+33 QUIT
+34 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
REF ; Check for refusals
+1 NEW TOP,RVDT,REVDT,RFIEN,CPT,MOD1,MOD2,QTY,CPTN
+2 SET TOP=""
+3 FOR
SET TOP=$ORDER(^AUPNPREF("AA",DFN,81,TOP))
IF TOP=""
QUIT
Begin DoDot:1
+4 SET RVDT=""
+5 FOR
SET RVDT=$ORDER(^AUPNPREF("AA",DFN,81,TOP,RVDT))
IF RVDT=""
QUIT
Begin DoDot:2
+6 ; Reverse the reverse date
+7 SET REVDT=9999999-RVDT
+8 IF DRANGE'=""
IF (REVDT\1)<DRANGE
QUIT
+9 SET RFIEN=""
+10 FOR
SET RFIEN=$ORDER(^AUPNPREF("AA",DFN,81,TOP,RVDT,RFIEN))
IF RFIEN=""
QUIT
Begin DoDot:3
+11 SET CPTN=$$GET1^DIQ(9000022,RFIEN_",",.06,"I")
+12 SET CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
+13 SET RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
+14 SET MOD2=""
SET QTY=""
+15 SET II=II+1
SET @DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_CPT_U_RSLT_U_MOD2_U_QTY_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
