BQIPTED ;PRXM/HC/ALA-Patient Education ; 23 Feb 2007 4:55 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EDU(DATA,DFN,DRANGE) ; EP -- BQI PATIENT EDUCATION
;
;Description - all the education that a patient has
;
;Input
; DFN - Patient internal entry number
;
NEW UID,II,IEN,TOPIC,VISIT,VSDTM,LEVEL,OPROV,EPROV,LENGTH,IG,COMM,PROV
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTED",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTED D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S DRANGE=$$DATE^BQIUL1($G(DRANGE))
S @DATA@(II)="I00010EDUC_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050TOPIC^I00003LENGTH^T00035PROVIDER^T00012STATUS^T00030LEVEL^T00001IG^T00100COMMENT"_$C(30)
S IEN=""
F S IEN=$O(^AUPNVPED("AC",DFN,IEN),-1) Q:IEN="" D
. S TOPIC=$$GET1^DIQ(9000010.16,IEN_",",.01,"E") I TOPIC="" Q
. S VISIT=$$GET1^DIQ(9000010.16,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.16,IEN_",",.06,"E")
. S LENGTH=$$GET1^DIQ(9000010.16,IEN_",",.08,"E")
. S IG=$$GET1^DIQ(9000010.16,IEN_",",.07,"I")
. S OPROV=$$GET1^DIQ(9000010.16,IEN_",",1202,"E")
. S COMM=$$GET1^DIQ(9000010.16,IEN_",",.11,"E")
. S STAT=$$GET1^DIQ(9000010.16,IEN_",",.13,"E")
. S EPROV=$$GET1^DIQ(9000010.16,IEN_",",1204,"E")
. S PROV=$$GET1^DIQ(9000010.16,IEN_",",.05,"E")
. S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TOPIC_U_LENGTH_U_PROV_U_STAT_U_LEVEL_U_IG_U_COMM_$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,TOPIC,RSLT,ORPHY,STAT,LEVEL,IG,COMM
S TOP=""
F S TOP=$O(^AUPNPREF("AA",DFN,9999999.09,TOP)) Q:TOP="" D
. S RVDT=""
. F S RVDT=$O(^AUPNPREF("AA",DFN,9999999.09,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,9999999.09,TOP,RVDT,RFIEN)) Q:RFIEN="" D
... S TOPIC=$$GET1^DIQ(9999999.09,TOP_",",.01,"E")
... S RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
... S STAT="",IG="",COMM="",LENGTH=""
... S II=II+1,@DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_TOPIC_U_LENGTH_U_ORPHY_U_STAT_U_RSLT_U_IG_U_COMM_$C(30)
Q
BQIPTED ;PRXM/HC/ALA-Patient Education ; 23 Feb 2007 4:55 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EDU(DATA,DFN,DRANGE) ; EP -- BQI PATIENT EDUCATION
+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,TOPIC,VISIT,VSDTM,LEVEL,OPROV,EPROV,LENGTH,IG,COMM,PROV
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQIPTED",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTED D UNWIND^%ZTER"
+14 ;
+15 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
+16 SET @DATA@(II)="I00010EDUC_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050TOPIC^I00003LENGTH^T00035PROVIDER^T00012STATUS^T00030LEVEL^T00001IG^T00100COMMENT"_$CHAR(30)
+17 SET IEN=""
+18 FOR
SET IEN=$ORDER(^AUPNVPED("AC",DFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+19 SET TOPIC=$$GET1^DIQ(9000010.16,IEN_",",.01,"E")
IF TOPIC=""
QUIT
+20 SET VISIT=$$GET1^DIQ(9000010.16,IEN_",",.03,"I")
IF VISIT=""
QUIT
+21 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSDTM=0
QUIT
+22 IF DRANGE'=""
IF (VSDTM\1<DRANGE)
QUIT
+23 SET LEVEL=$$GET1^DIQ(9000010.16,IEN_",",.06,"E")
+24 SET LENGTH=$$GET1^DIQ(9000010.16,IEN_",",.08,"E")
+25 SET IG=$$GET1^DIQ(9000010.16,IEN_",",.07,"I")
+26 SET OPROV=$$GET1^DIQ(9000010.16,IEN_",",1202,"E")
+27 SET COMM=$$GET1^DIQ(9000010.16,IEN_",",.11,"E")
+28 SET STAT=$$GET1^DIQ(9000010.16,IEN_",",.13,"E")
+29 SET EPROV=$$GET1^DIQ(9000010.16,IEN_",",1204,"E")
+30 SET PROV=$$GET1^DIQ(9000010.16,IEN_",",.05,"E")
+31 SET II=II+1
SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TOPIC_U_LENGTH_U_PROV_U_STAT_U_LEVEL_U_IG_U_COMM_$CHAR(30)
End DoDot:1
+32 ;
+33 ; Check for refusals
+34 DO REF
+35 ;
+36 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+37 QUIT
+38 ;
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,TOPIC,RSLT,ORPHY,STAT,LEVEL,IG,COMM
+2 SET TOP=""
+3 FOR
SET TOP=$ORDER(^AUPNPREF("AA",DFN,9999999.09,TOP))
IF TOP=""
QUIT
Begin DoDot:1
+4 SET RVDT=""
+5 FOR
SET RVDT=$ORDER(^AUPNPREF("AA",DFN,9999999.09,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,9999999.09,TOP,RVDT,RFIEN))
IF RFIEN=""
QUIT
Begin DoDot:3
+11 SET TOPIC=$$GET1^DIQ(9999999.09,TOP_",",.01,"E")
+12 SET RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
+13 SET ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
+14 SET STAT=""
SET IG=""
SET COMM=""
SET LENGTH=""
+15 SET II=II+1
SET @DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_TOPIC_U_LENGTH_U_ORPHY_U_STAT_U_RSLT_U_IG_U_COMM_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
