BQIREM ;PRXM/HC/DLS - BQI PATIENT NATIONAL REMINDERS ; 20 Dec 2005 3:52 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
;
Q
;
EN(DATA,DFN) ; EP -- BQI PATIENT NATIONAL REMINDERS
;Description
; Gets a list of precalculated reminders for a patient
;
;Input
; DFN - Patient IEN
;
;Output
; DATA - Name of global in which data is stored(^TMP("BQIREM"))
;
NEW UID,X,BQII,RDATA,IEN,REMCODE,REMNEXT,REMDUE,REMLAST,UPDT,VISIT
NEW REMDATE,RCAT,RCLIN,ORD,PRI,REMDESC,NPRI,LPRI,REG,RGIEN,RIEN,RLIST
NEW QFL,PREV,PRDT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIREM",UID))
K @DATA
;
S RLIST=$G(RLIST,"")
S BQII=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIREM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR
S IEN=0
F S IEN=$O(^BQIPAT(DFN,40,IEN)) Q:'IEN D
. S RDATA=^BQIPAT(DFN,40,IEN,0)
. S REMCODE=$P(RDATA,U,1)
. S RIEN=$O(^BQI(90506.1,"B",REMCODE,""))
. I RIEN="" Q
. I $P(^BQI(90506.1,RIEN,0),U,10)=1 Q
. S REMDESC=$P(^BQI(90506.1,RIEN,0),U,3)
. I REMDESC'?.U S REMDESC=REMDESC
. I REMDESC?.UP S REMDESC=$$LOWER^VALM1(REMDESC)
. I REMDESC="Breast Mri" S REMDESC="Breast MRI"
. S REMLAST=$P(RDATA,U,2)
. S REMNEXT=$P(RDATA,U,3)
. I $P(REMCODE,"_",1)="EHR",REMNEXT="N/A" Q
. S REMDUE=$P(RDATA,U,4)
. S UPDT=$P(RDATA,U,5)
. S VISIT=$P(RDATA,U,6)
. I REMNEXT="",REMDUE="" Q
. S PREV="N/A",PRDT=""
. S:REMDUE="" REMDUE=DT
. I $P(REMCODE,"_",1)="EHR" D
.. I REMNEXT="DONE" S REMDUE=""
.. I REMNEXT="RESOLVED" S REMDUE=""
. ;S RCAT=$$GET1^DIQ(90506.1,RIEN_",",2.03,"E")
. S RCAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
. ;S RCLIN=$$GET1^DIQ(90506.1,RIEN_",",2.05,"E")
. S RCLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
. S PRI="~",QFL=0
. I $P(REMCODE,"_",1)="REG" D Q:QFL
.. S REG=$P(REMCODE,"_",2),RGIEN=$P(REMCODE,"_",3)
.. NEW SRC
.. S SRC=$O(^BQI(90506.5,"D",REG,""))
.. I SRC'="",'$$NRPC^BQICMDNM(DFN,SRC) S QFL=1 Q
.. S PRI=$P(^BQI(90507,REG,15,RGIEN,0),U,9)
. I $P(REMCODE,"_",1)="CMET" D
.. NEW PRVN,RMIEN
.. S RMIEN=""
.. F S RMIEN=$O(^BTPWP("AE",DFN,"F",RMIEN)) Q:RMIEN="" D
... I $P(^BTPWP(RMIEN,0),U,1)'=$P(REMCODE,"_",2) Q
... S PRVN=$P(^BTPWP(RMIEN,0),U,11)
... S PREV=$$GET1^DIQ(90620,PRVN_",",.01,"E")
... S PRDT=$$FMTE^BQIUL1($$GET1^DIQ(90620,PRVN_",",.03,"I"))
. ;
. S ORD(PRI,RIEN)=RCAT_U_RCLIN_U_REMCODE_U_REMDESC_U_$$FMTE^BQIUL1(REMLAST)_U_REMNEXT_U_$$FMTE^BQIUL1(REMDUE)_U_$$FMTE^BQIUL1(UPDT)_U_VISIT_U_PREV_U_PRDT
;
S PRI=""
F S PRI=$O(ORD(PRI)) Q:PRI="" D S:PRI'="~" NPRI=PRI
. S RIEN=""
. F S RIEN=$O(ORD(PRI,RIEN)) Q:RIEN="" D
.. I PRI'="~" S LPRI=PRI
.. I PRI="~" S NPRI=$G(NPRI)+1,LPRI=NPRI
.. S BQII=BQII+1,@DATA@(BQII)=ORD(PRI,RIEN)_U_LPRI_$C(30)
;
DONE ; Finished
S BQII=BQII+1
S @DATA@(BQII)=$C(31)
Q
;
HDR ; Header
S @DATA@(BQII)="T00030CATEGORY^T00030CLIN_GROUP^T00015REM_CODE^T00050REM_DESC^D00010REM_LAST^"
S @DATA@(BQII)=@DATA@(BQII)_"T00040REM_NEXT^D00010REM_DUE^D00030LAST_UPDATED^I00010VISIT_IEN^"
S @DATA@(BQII)=@DATA@(BQII)_"T00050PREV_EVENT^D00015PREV_DATE^I00003DISPLAY_ORDER"_$C(30)
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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
I $$TMPFL^BQIUL1("C")
Q
;
IMM(IDFN,IMIEN) ;EP - Get immunization due/last information
; Input
; IDFN - Patient internal entry number
; IMIEN - Immunization internal entry number
;
NEW BIIEN,BIDATA,BILAST
S BIIEN="",BIDATA=""
F S BIIEN=$O(^BIPDUE("B",IDFN,BIIEN)) Q:BIIEN="" D
. I $G(^BIPDUE(BIIEN,0))="" Q
. I $P(^BIPDUE(BIIEN,0),U,2)'=IMIEN Q
. S BIDATA=$P(^BIPDUE(BIIEN,0),U,4)_U_$$FMTE^XLFDT($P(^BIPDUE(BIIEN,0),U,5),"2Z")
. I $$PATCH^XPDUTL("BI*8.3*1") S BIDATA=BIDATA_U_$$LIMM(IDFN,IMIEN)
Q BIDATA
;
LIMM(IDFN,IMIEN) ; EP - Get Last Immunization
; Input
; IDFN - Patient internal entry number
; IMIEN - Immunization internal entry number
NEW IRVDT,IRIEN,RVIS,RVALUE,FOK
S RVALUE="",FOK=0,IRVDT=""
F S IRVDT=$O(^AUPNVIMM("AA",IDFN,IMIEN,IRVDT)) Q:IRVDT="" D Q:FOK
. S IRIEN=""
. F S IRIEN=$O(^AUPNVIMM("AA",IDFN,IMIEN,IRVDT,IRIEN)) Q:IRIEN="" D Q:FOK
.. S RVIS=$P($G(^AUPNVIMM(IRIEN,0)),U,3) I RVIS="" Q
.. I $$GET1^DIQ(9000010,RVIS_",",.11,"I")=1 Q
.. S RVALUE=$$GET1^DIQ(9000010,RVIS_",",.01,"I")\1_U_RVIS_U_IRIEN,FOK=1
Q RVALUE
BQIREM ;PRXM/HC/DLS - BQI PATIENT NATIONAL REMINDERS ; 20 Dec 2005 3:52 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
+2 ;
+3 QUIT
+4 ;
EN(DATA,DFN) ; EP -- BQI PATIENT NATIONAL REMINDERS
+1 ;Description
+2 ; Gets a list of precalculated reminders for a patient
+3 ;
+4 ;Input
+5 ; DFN - Patient IEN
+6 ;
+7 ;Output
+8 ; DATA - Name of global in which data is stored(^TMP("BQIREM"))
+9 ;
+10 NEW UID,X,BQII,RDATA,IEN,REMCODE,REMNEXT,REMDUE,REMLAST,UPDT,VISIT
+11 NEW REMDATE,RCAT,RCLIN,ORD,PRI,REMDESC,NPRI,LPRI,REG,RGIEN,RIEN,RLIST
+12 NEW QFL,PREV,PRDT
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIREM",UID))
+15 KILL @DATA
+16 ;
+17 SET RLIST=$GET(RLIST,"")
+18 SET BQII=0
+19 ;
+20 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIREM D UNWIND^%ZTER"
+21 ;
+22 DO HDR
+23 SET IEN=0
+24 FOR
SET IEN=$ORDER(^BQIPAT(DFN,40,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+25 SET RDATA=^BQIPAT(DFN,40,IEN,0)
+26 SET REMCODE=$PIECE(RDATA,U,1)
+27 SET RIEN=$ORDER(^BQI(90506.1,"B",REMCODE,""))
+28 IF RIEN=""
QUIT
+29 IF $PIECE(^BQI(90506.1,RIEN,0),U,10)=1
QUIT
+30 SET REMDESC=$PIECE(^BQI(90506.1,RIEN,0),U,3)
+31 IF REMDESC'?.U
SET REMDESC=REMDESC
+32 IF REMDESC?.UP
SET REMDESC=$$LOWER^VALM1(REMDESC)
+33 IF REMDESC="Breast Mri"
SET REMDESC="Breast MRI"
+34 SET REMLAST=$PIECE(RDATA,U,2)
+35 SET REMNEXT=$PIECE(RDATA,U,3)
+36 IF $PIECE(REMCODE,"_",1)="EHR"
IF REMNEXT="N/A"
QUIT
+37 SET REMDUE=$PIECE(RDATA,U,4)
+38 SET UPDT=$PIECE(RDATA,U,5)
+39 SET VISIT=$PIECE(RDATA,U,6)
+40 IF REMNEXT=""
IF REMDUE=""
QUIT
+41 SET PREV="N/A"
SET PRDT=""
+42 IF REMDUE=""
SET REMDUE=DT
+43 IF $PIECE(REMCODE,"_",1)="EHR"
Begin DoDot:2
+44 IF REMNEXT="DONE"
SET REMDUE=""
+45 IF REMNEXT="RESOLVED"
SET REMDUE=""
End DoDot:2
+46 ;S RCAT=$$GET1^DIQ(90506.1,RIEN_",",2.03,"E")
+47 SET RCAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
+48 ;S RCLIN=$$GET1^DIQ(90506.1,RIEN_",",2.05,"E")
+49 SET RCLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
+50 SET PRI="~"
SET QFL=0
+51 IF $PIECE(REMCODE,"_",1)="REG"
Begin DoDot:2
+52 SET REG=$PIECE(REMCODE,"_",2)
SET RGIEN=$PIECE(REMCODE,"_",3)
+53 NEW SRC
+54 SET SRC=$ORDER(^BQI(90506.5,"D",REG,""))
+55 IF SRC'=""
IF '$$NRPC^BQICMDNM(DFN,SRC)
SET QFL=1
QUIT
+56 SET PRI=$PIECE(^BQI(90507,REG,15,RGIEN,0),U,9)
End DoDot:2
IF QFL
QUIT
+57 IF $PIECE(REMCODE,"_",1)="CMET"
Begin DoDot:2
+58 NEW PRVN,RMIEN
+59 SET RMIEN=""
+60 FOR
SET RMIEN=$ORDER(^BTPWP("AE",DFN,"F",RMIEN))
IF RMIEN=""
QUIT
Begin DoDot:3
+61 IF $PIECE(^BTPWP(RMIEN,0),U,1)'=$PIECE(REMCODE,"_",2)
QUIT
+62 SET PRVN=$PIECE(^BTPWP(RMIEN,0),U,11)
+63 SET PREV=$$GET1^DIQ(90620,PRVN_",",.01,"E")
+64 SET PRDT=$$FMTE^BQIUL1($$GET1^DIQ(90620,PRVN_",",.03,"I"))
End DoDot:3
End DoDot:2
+65 ;
+66 SET ORD(PRI,RIEN)=RCAT_U_RCLIN_U_REMCODE_U_REMDESC_U_$$FMTE^BQIUL1(REMLAST)_U_REMNEXT_U_$$FMTE^BQIUL1(REMDUE)_U_$$FMTE^BQIUL1(UPDT)_U_VISIT_U_PREV_U_PRDT
End DoDot:1
+67 ;
+68 SET PRI=""
+69 FOR
SET PRI=$ORDER(ORD(PRI))
IF PRI=""
QUIT
Begin DoDot:1
+70 SET RIEN=""
+71 FOR
SET RIEN=$ORDER(ORD(PRI,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+72 IF PRI'="~"
SET LPRI=PRI
+73 IF PRI="~"
SET NPRI=$GET(NPRI)+1
SET LPRI=NPRI
+74 SET BQII=BQII+1
SET @DATA@(BQII)=ORD(PRI,RIEN)_U_LPRI_$CHAR(30)
End DoDot:2
End DoDot:1
IF PRI'="~"
SET NPRI=PRI
+75 ;
DONE ; Finished
+1 SET BQII=BQII+1
+2 SET @DATA@(BQII)=$CHAR(31)
+3 QUIT
+4 ;
HDR ; Header
+1 SET @DATA@(BQII)="T00030CATEGORY^T00030CLIN_GROUP^T00015REM_CODE^T00050REM_DESC^D00010REM_LAST^"
+2 SET @DATA@(BQII)=@DATA@(BQII)_"T00040REM_NEXT^D00010REM_DUE^D00030LAST_UPDATED^I00010VISIT_IEN^"
+3 SET @DATA@(BQII)=@DATA@(BQII)_"T00050PREV_EVENT^D00015PREV_DATE^I00003DISPLAY_ORDER"_$CHAR(30)
+4 QUIT
+5 ;
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(BQII)
IF $DATA(DATA)
SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+6 IF $$TMPFL^BQIUL1("C")
+7 QUIT
+8 ;
IMM(IDFN,IMIEN) ;EP - Get immunization due/last information
+1 ; Input
+2 ; IDFN - Patient internal entry number
+3 ; IMIEN - Immunization internal entry number
+4 ;
+5 NEW BIIEN,BIDATA,BILAST
+6 SET BIIEN=""
SET BIDATA=""
+7 FOR
SET BIIEN=$ORDER(^BIPDUE("B",IDFN,BIIEN))
IF BIIEN=""
QUIT
Begin DoDot:1
+8 IF $GET(^BIPDUE(BIIEN,0))=""
QUIT
+9 IF $PIECE(^BIPDUE(BIIEN,0),U,2)'=IMIEN
QUIT
+10 SET BIDATA=$PIECE(^BIPDUE(BIIEN,0),U,4)_U_$$FMTE^XLFDT($PIECE(^BIPDUE(BIIEN,0),U,5),"2Z")
+11 IF $$PATCH^XPDUTL("BI*8.3*1")
SET BIDATA=BIDATA_U_$$LIMM(IDFN,IMIEN)
End DoDot:1
+12 QUIT BIDATA
+13 ;
LIMM(IDFN,IMIEN) ; EP - Get Last Immunization
+1 ; Input
+2 ; IDFN - Patient internal entry number
+3 ; IMIEN - Immunization internal entry number
+4 NEW IRVDT,IRIEN,RVIS,RVALUE,FOK
+5 SET RVALUE=""
SET FOK=0
SET IRVDT=""
+6 FOR
SET IRVDT=$ORDER(^AUPNVIMM("AA",IDFN,IMIEN,IRVDT))
IF IRVDT=""
QUIT
Begin DoDot:1
+7 SET IRIEN=""
+8 FOR
SET IRIEN=$ORDER(^AUPNVIMM("AA",IDFN,IMIEN,IRVDT,IRIEN))
IF IRIEN=""
QUIT
Begin DoDot:2
+9 SET RVIS=$PIECE($GET(^AUPNVIMM(IRIEN,0)),U,3)
IF RVIS=""
QUIT
+10 IF $$GET1^DIQ(9000010,RVIS_",",.11,"I")=1
QUIT
+11 SET RVALUE=$$GET1^DIQ(9000010,RVIS_",",.01,"I")\1_U_RVIS_U_IRIEN
SET FOK=1
End DoDot:2
IF FOK
QUIT
End DoDot:1
IF FOK
QUIT
+12 QUIT RVALUE
