BQIRMPL ;PRXM/HC/ALA-Reminders By Panel ; 20 Feb 2007 4:04 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
;
Q
;
EN(DATA,OWNR,PLIEN,PLIST) ;EP -- BQI GET REMINDERS BY PANEL
;Description - Entry point for the panel
;Input Parameters
; OWNR - Owner of panel
; PLIEN - Panel IEN
; PLIST - List of DFNs (optional)
NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG,STVWCD
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRMPL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMPL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; If a list of DFNs, process them instead of entire panel
I $D(PLIST)>0 D G DONE
. I $D(PLIST)>1 D
.. S LIST="",BN=""
.. F S BN=$O(PLIST(BN)) Q:BN="" S LIST=LIST_PLIST(BN)
.. K PLIST S PLIST=LIST
. F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN="" D
.. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
.. D PAT(.DATA,OWNR,PLIEN,DFN)
;
S DFN=0
I $O(^BQICARE(OWNR,1,PLIEN,40,DFN))="" D PAT(.DATA,OWNR,PLIEN,"") G DONE
;
F S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN D
. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
. D PAT(.DATA,OWNR,PLIEN,DFN)
;
DONE ;
I II=0,$G(@DATA@(II))="" D PAT(.DATA,OWNR,PLIEN,"")
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
;
PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,ORD
S VALUE="",CTYP="R"
I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
I DFN'="" S VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
; Check for template
NEW DA,IENS,TEMPL,LYIEN,QFL
S TEMPL=""
I OWNR'=DUZ D
. S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
. I DA="" Q
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,IENS=$$IENS^DILF(.DA)
. S TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
I OWNR=DUZ D
. S DA=$O(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
. I DA="" Q
. S DA(2)=OWNR,DA(1)=PLIEN,IENS=$$IENS^DILF(.DA)
. S TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
;
; If template, use it
I TEMPL'="" S QFL=0 D G FIN:'QFL
. ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
. S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
. I LYIEN="" S QFL=1 Q
. S DOR=""
. F S DOR=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR)) Q:DOR="" D
.. S IEN=""
.. F S IEN=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR,IEN)) Q:IEN="" D
... S CODE=$P(^BQICARE(DUZ,15,LYIEN,1,IEN,0),U,1)
... S GIEN=$O(^BQI(90506.1,"B",CODE,"")) I GIEN="" Q
... S STVW=GIEN
... I $P(^BQI(90506.1,GIEN,0),U,10)=1 Q
... S HDR=$$GET1^DIQ(90506.1,GIEN_",",.08,"E")
... I $$GET1^DIQ(90506.1,GIEN_",",3.01,"E")="Patient" S STVW=GIEN D CVAL
... I $$GET1^DIQ(90506.1,GIEN_",",3.01,"E")="Reminders" S STVW=CODE D RMVL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
;
; If no template, check for customized
I OWNR=DUZ D
. S IEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,22,IEN))
. I CIEN'="" D Q
.. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,22,IEN)) Q:'IEN D
... S CODE=$P(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",1)
... S SIEN=$O(^BQI(90506.1,"B",CODE,"")) I SIEN="" Q
... I $P(^BQI(90506.1,SIEN,0),U,10)=1 Q
... S HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders" S STVW=CODE D RMVL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
. ;
. ; If no customized found, use default
. I CIEN="" D STAND()
;
I OWNR'=DUZ D
. S IEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN))
. I CIEN'="" D Q
.. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN)) Q:'IEN D
... S CODE=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",1)
... S SIEN=$O(^BQI(90506.1,"B",CODE,"")) I SIEN="" Q
... I $P(^BQI(90506.1,SIEN,0),U,10)=1 Q
... S HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders" S STVW=CODE D RMVL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
. ;
. ; If no customized found, use default
. I CIEN="" D STAND()
;
FIN ; Finish
; remove trailing up-arrows
S HEADR=$$TKO^BQIUL1(HEADR,"^")
S VALUE=$$TKO^BQIUL1(VALUE,"^")
I DFN="" S VALUE=""
;
I II=0 S @DATA@(II)=HEADR_$C(30)
I VALUE'="",$P($G(@DATA@(II)),$C(30),1)'=VALUE S II=II+1,@DATA@(II)=VALUE_$C(30)
Q
;
STAND() ;EP - Get standard display
NEW IEN,HDR,SENS,HDOB,Y,STVW,TEXT,ORD,KEY
S VALUE=""
I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
I DFN'="" S VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
S IEN=""
F S IEN=$O(^BQI(90506.1,"AC","D",IEN)) Q:IEN="" D
. I $P(^BQI(90506.1,IEN,0),U,10)=1 Q
. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
.. S STVW=IEN
.. D CVAL
.. S VALUE=VALUE_VAL_"^"
.. S HEADR=HEADR_HDR_"^"
;
S IEN=""
F S IEN=$O(^BQI(90506.1,"AC","R",IEN)) Q:IEN="" D
. I $P(^BQI(90506.1,IEN,0),U,10)=1 Q
. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
.. S STVW=$P(^BQI(90506.1,IEN,0),U,1)
.. S HDR=$P(^BQI(90506.1,IEN,0),U,8)
.. D RMVL
.. S VALUE=VALUE_VAL_"^"
.. S HEADR=HEADR_HDR_"^"
S HEADR=$$TKO^BQIUL1(HEADR,"^")
S VALUE=$$TKO^BQIUL1(VALUE,"^")
;
I DFN="" S VALUE=""
;
I II=0 S @DATA@(II)=HEADR_$C(30)
I VALUE'="" S II=II+1,@DATA@(II)=VALUE_$C(30)
Q
;
CVAL ; Get demographic values
;Parameters
; FIL = FileMan file number
; FLD = FileMan field number
; EXEC = If an executable is needed to determine value
; HDR = Header value
;the executable expects the value to be returned in variable VAL
NEW FIL,FLD,EXEC
S FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
S FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
S EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
S HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
I $G(DFN)="" S VAL="" Q
;
I $G(EXEC)'="" X EXEC Q
;
I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
Q
;
RMVL ; Reminder value
NEW RDATA,CT,I,RIEN,BQIDOD,CMIEN,REG,DUE
S CMIEN=""
I DFN="" S VAL="",HDR="T00025"_STVW Q
; If patient is deceased
S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I") I BQIDOD'="" S VAL="1/1/0001 12:00:00 AM" Q
; if patient has no reminders, then No Data Available (NDA)
I $O(^BQIPAT(DFN,40,0))="" S VAL="1/1/0001 12:00:00 AM" Q
I $L(STVW,"_")>2 D
. S REG=$P(STVW,"_",2) I REG'="" D
.. S CMIEN=$O(^BQI(90506.5,"D",REG,""))
; if patient does not meet denominator, then Not Applicable (N/A)
I CMIEN'="",'$$NRPC^BQICMDNM(DFN,CMIEN) S VAL="1/1/0001 12:01:00 AM" Q
; if patient has no data for this particular reminder, then Not Applicable (N/A)
S RIEN=$O(^BQIPAT(DFN,40,"B",STVW,"")) I RIEN="" S VAL="1/1/0001 12:01:00 AM" Q
S RDATA=$G(^BQIPAT(DFN,40,RIEN,0))
S CT=0
; if a particular reminder is completed with DONE or RESOLVED, then Not Applicable (N/A)
I $P(STVW,"_",1)="EHR" S EQFL=0 D Q:EQFL
. I $P(RDATA,U,3)="N/A" S VAL="1/1/0001 12:01:00 AM",EQFL=1 Q
. I $P(RDATA,U,3)="DONE" S VAL="1/1/0001 12:01:00 AM",EQFL=1 Q
. I $P(RDATA,U,3)="RESOLVED" S VAL="1/1/0001 12:01:00 AM",EQFL=1 Q
F I=2:1:4 S:$P(RDATA,U,I)'=""&($P(RDATA,U,I)'="N/A") CT=CT+1
S HDR="T00030"_STVW
I CT=0 S VAL="1/1/0001 12:01:00 AM" Q
S DUE=$P(RDATA,U,4)
I $P(RDATA,U,3)'="",DUE="" S DUE=DT
S VAL=$$FMTMDY^BQIUL1(DUE)
Q
;
RDEF() ;EP - Reminders default
NEW RVALUE,IEN,STVCD,REMNM,BQIARRAY,KEY
S RVALUE=""
;
; Check for normal display order
S DOR="" F S DOR=$O(^BQI(90506.1,"AD","D",DOR)) Q:DOR="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AD","D",DOR,IEN)) Q:IEN="" D
.. I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
.. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
... S RVALUE=RVALUE_STVCD_$C(29)
S IEN=""
F S IEN=$O(^BQI(90506.1,"AC","R",IEN)) Q:IEN="" D
. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
.. I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
.. S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
.. S REMNM=$$GET1^DIQ(90506.1,IEN_",",.03,"E")
.. S BQIARRAY(REMNM,IEN)=STVCD
S REMNM=""
F S REMNM=$O(BQIARRAY(REMNM)) Q:REMNM="" D
. S IEN=""
. F S IEN=$O(BQIARRAY(REMNM,IEN)) Q:IEN="" D
.. S STVCD=BQIARRAY(REMNM,IEN)
.. S RVALUE=RVALUE_STVCD_$C(29)
S RVALUE=$$TKO^BQIUL1(RVALUE,$C(29))
Q RVALUE
BQIRMPL ;PRXM/HC/ALA-Reminders By Panel ; 20 Feb 2007 4:04 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
+2 ;
+3 QUIT
+4 ;
EN(DATA,OWNR,PLIEN,PLIST) ;EP -- BQI GET REMINDERS BY PANEL
+1 ;Description - Entry point for the panel
+2 ;Input Parameters
+3 ; OWNR - Owner of panel
+4 ; PLIEN - Panel IEN
+5 ; PLIST - List of DFNs (optional)
+6 NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG,STVWCD
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQIRMPL",UID))
+9 KILL @DATA
+10 ;
+11 SET II=0
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRMPL D UNWIND^%ZTER"
+13 ;
+14 ; If a list of DFNs, process them instead of entire panel
+15 IF $DATA(PLIST)>0
Begin DoDot:1
+16 IF $DATA(PLIST)>1
Begin DoDot:2
+17 SET LIST=""
SET BN=""
+18 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+19 KILL PLIST
SET PLIST=LIST
End DoDot:2
+20 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:2
+21 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+22 DO PAT(.DATA,OWNR,PLIEN,DFN)
End DoDot:2
End DoDot:1
GOTO DONE
+23 ;
+24 SET DFN=0
+25 IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))=""
DO PAT(.DATA,OWNR,PLIEN,"")
GOTO DONE
+26 ;
+27 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+28 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+29 DO PAT(.DATA,OWNR,PLIEN,DFN)
End DoDot:1
+30 ;
DONE ;
+1 IF II=0
IF $GET(@DATA@(II))=""
DO PAT(.DATA,OWNR,PLIEN,"")
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
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 ;
PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
+1 NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,ORD
+2 SET VALUE=""
SET CTYP="R"
+3 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+4 IF DFN'=""
SET VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
+5 SET HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
+6 ; Check for template
+7 NEW DA,IENS,TEMPL,LYIEN,QFL
+8 SET TEMPL=""
+9 IF OWNR'=DUZ
Begin DoDot:1
+10 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
+11 IF DA=""
QUIT
+12 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET IENS=$$IENS^DILF(.DA)
+13 SET TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
End DoDot:1
+14 IF OWNR=DUZ
Begin DoDot:1
+15 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
+16 IF DA=""
QUIT
+17 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET IENS=$$IENS^DILF(.DA)
+18 SET TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
End DoDot:1
+19 ;
+20 ; If template, use it
+21 IF TEMPL'=""
SET QFL=0
Begin DoDot:1
+22 ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
+23 SET LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
+24 IF LYIEN=""
SET QFL=1
QUIT
+25 SET DOR=""
+26 FOR
SET DOR=$ORDER(^BQICARE(DUZ,15,LYIEN,1,"C",DOR))
IF DOR=""
QUIT
Begin DoDot:2
+27 SET IEN=""
+28 FOR
SET IEN=$ORDER(^BQICARE(DUZ,15,LYIEN,1,"C",DOR,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+29 SET CODE=$PIECE(^BQICARE(DUZ,15,LYIEN,1,IEN,0),U,1)
+30 SET GIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF GIEN=""
QUIT
+31 SET STVW=GIEN
+32 IF $PIECE(^BQI(90506.1,GIEN,0),U,10)=1
QUIT
+33 SET HDR=$$GET1^DIQ(90506.1,GIEN_",",.08,"E")
+34 IF $$GET1^DIQ(90506.1,GIEN_",",3.01,"E")="Patient"
SET STVW=GIEN
DO CVAL
+35 IF $$GET1^DIQ(90506.1,GIEN_",",3.01,"E")="Reminders"
SET STVW=CODE
DO RMVL
+36 SET VALUE=VALUE_VAL_"^"
+37 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
End DoDot:1
IF 'QFL
GOTO FIN
+38 ;
+39 ; If no template, check for customized
+40 IF OWNR=DUZ
Begin DoDot:1
+41 SET IEN=0
SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,22,IEN))
+42 IF CIEN'=""
Begin DoDot:2
+43 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,22,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+44 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",1)
+45 SET SIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF SIEN=""
QUIT
+46 IF $PIECE(^BQI(90506.1,SIEN,0),U,10)=1
QUIT
+47 SET HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
+48 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient"
SET STVW=SIEN
DO CVAL
+49 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders"
SET STVW=CODE
DO RMVL
+50 SET VALUE=VALUE_VAL_"^"
+51 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
QUIT
+52 ;
+53 ; If no customized found, use default
+54 IF CIEN=""
DO STAND()
End DoDot:1
+55 ;
+56 IF OWNR'=DUZ
Begin DoDot:1
+57 SET IEN=0
SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN))
+58 IF CIEN'=""
Begin DoDot:2
+59 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+60 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",1)
+61 SET SIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF SIEN=""
QUIT
+62 IF $PIECE(^BQI(90506.1,SIEN,0),U,10)=1
QUIT
+63 SET HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
+64 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient"
SET STVW=SIEN
DO CVAL
+65 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders"
SET STVW=CODE
DO RMVL
+66 SET VALUE=VALUE_VAL_"^"
+67 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
QUIT
+68 ;
+69 ; If no customized found, use default
+70 IF CIEN=""
DO STAND()
End DoDot:1
+71 ;
FIN ; Finish
+1 ; remove trailing up-arrows
+2 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+3 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+4 IF DFN=""
SET VALUE=""
+5 ;
+6 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+7 IF VALUE'=""
IF $PIECE($GET(@DATA@(II)),$CHAR(30),1)'=VALUE
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+8 QUIT
+9 ;
STAND() ;EP - Get standard display
+1 NEW IEN,HDR,SENS,HDOB,Y,STVW,TEXT,ORD,KEY
+2 SET VALUE=""
+3 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+4 IF DFN'=""
SET VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
+5 SET HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC","D",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+8 IF $PIECE(^BQI(90506.1,IEN,0),U,10)=1
QUIT
+9 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+10 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+11 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:2
+12 SET STVW=IEN
+13 DO CVAL
+14 SET VALUE=VALUE_VAL_"^"
+15 SET HEADR=HEADR_HDR_"^"
End DoDot:2
End DoDot:1
+16 ;
+17 SET IEN=""
+18 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC","R",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+19 IF $PIECE(^BQI(90506.1,IEN,0),U,10)=1
QUIT
+20 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+21 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+22 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:2
+23 SET STVW=$PIECE(^BQI(90506.1,IEN,0),U,1)
+24 SET HDR=$PIECE(^BQI(90506.1,IEN,0),U,8)
+25 DO RMVL
+26 SET VALUE=VALUE_VAL_"^"
+27 SET HEADR=HEADR_HDR_"^"
End DoDot:2
End DoDot:1
+28 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+29 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+30 ;
+31 IF DFN=""
SET VALUE=""
+32 ;
+33 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+34 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+35 QUIT
+36 ;
CVAL ; Get demographic values
+1 ;Parameters
+2 ; FIL = FileMan file number
+3 ; FLD = FileMan field number
+4 ; EXEC = If an executable is needed to determine value
+5 ; HDR = Header value
+6 ;the executable expects the value to be returned in variable VAL
+7 NEW FIL,FLD,EXEC
+8 SET FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
+9 SET FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
+10 SET EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
+11 SET HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
+12 IF $GET(DFN)=""
SET VAL=""
QUIT
+13 ;
+14 IF $GET(EXEC)'=""
XECUTE EXEC
QUIT
+15 ;
+16 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+17 QUIT
+18 ;
RMVL ; Reminder value
+1 NEW RDATA,CT,I,RIEN,BQIDOD,CMIEN,REG,DUE
+2 SET CMIEN=""
+3 IF DFN=""
SET VAL=""
SET HDR="T00025"_STVW
QUIT
+4 ; If patient is deceased
+5 SET BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
IF BQIDOD'=""
SET VAL="1/1/0001 12:00:00 AM"
QUIT
+6 ; if patient has no reminders, then No Data Available (NDA)
+7 IF $ORDER(^BQIPAT(DFN,40,0))=""
SET VAL="1/1/0001 12:00:00 AM"
QUIT
+8 IF $LENGTH(STVW,"_")>2
Begin DoDot:1
+9 SET REG=$PIECE(STVW,"_",2)
IF REG'=""
Begin DoDot:2
+10 SET CMIEN=$ORDER(^BQI(90506.5,"D",REG,""))
End DoDot:2
End DoDot:1
+11 ; if patient does not meet denominator, then Not Applicable (N/A)
+12 IF CMIEN'=""
IF '$$NRPC^BQICMDNM(DFN,CMIEN)
SET VAL="1/1/0001 12:01:00 AM"
QUIT
+13 ; if patient has no data for this particular reminder, then Not Applicable (N/A)
+14 SET RIEN=$ORDER(^BQIPAT(DFN,40,"B",STVW,""))
IF RIEN=""
SET VAL="1/1/0001 12:01:00 AM"
QUIT
+15 SET RDATA=$GET(^BQIPAT(DFN,40,RIEN,0))
+16 SET CT=0
+17 ; if a particular reminder is completed with DONE or RESOLVED, then Not Applicable (N/A)
+18 IF $PIECE(STVW,"_",1)="EHR"
SET EQFL=0
Begin DoDot:1
+19 IF $PIECE(RDATA,U,3)="N/A"
SET VAL="1/1/0001 12:01:00 AM"
SET EQFL=1
QUIT
+20 IF $PIECE(RDATA,U,3)="DONE"
SET VAL="1/1/0001 12:01:00 AM"
SET EQFL=1
QUIT
+21 IF $PIECE(RDATA,U,3)="RESOLVED"
SET VAL="1/1/0001 12:01:00 AM"
SET EQFL=1
QUIT
End DoDot:1
IF EQFL
QUIT
+22 FOR I=2:1:4
IF $PIECE(RDATA,U,I)'=""&($PIECE(RDATA,U,I)'="N/A")
SET CT=CT+1
+23 SET HDR="T00030"_STVW
+24 IF CT=0
SET VAL="1/1/0001 12:01:00 AM"
QUIT
+25 SET DUE=$PIECE(RDATA,U,4)
+26 IF $PIECE(RDATA,U,3)'=""
IF DUE=""
SET DUE=DT
+27 SET VAL=$$FMTMDY^BQIUL1(DUE)
+28 QUIT
+29 ;
RDEF() ;EP - Reminders default
+1 NEW RVALUE,IEN,STVCD,REMNM,BQIARRAY,KEY
+2 SET RVALUE=""
+3 ;
+4 ; Check for normal display order
+5 SET DOR=""
FOR
SET DOR=$ORDER(^BQI(90506.1,"AD","D",DOR))
IF DOR=""
QUIT
Begin DoDot:1
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD","D",DOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+8 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+9 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+10 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+11 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+12 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+13 SET RVALUE=RVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET IEN=""
+15 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC","R",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+16 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+17 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+18 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:2
+19 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+20 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+21 SET REMNM=$$GET1^DIQ(90506.1,IEN_",",.03,"E")
+22 SET BQIARRAY(REMNM,IEN)=STVCD
End DoDot:2
End DoDot:1
+23 SET REMNM=""
+24 FOR
SET REMNM=$ORDER(BQIARRAY(REMNM))
IF REMNM=""
QUIT
Begin DoDot:1
+25 SET IEN=""
+26 FOR
SET IEN=$ORDER(BQIARRAY(REMNM,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+27 SET STVCD=BQIARRAY(REMNM,IEN)
+28 SET RVALUE=RVALUE_STVCD_$CHAR(29)
End DoDot:2
End DoDot:1
+29 SET RVALUE=$$TKO^BQIUL1(RVALUE,$CHAR(29))
+30 QUIT RVALUE
