BQIMSPL ;PRXM/HC/ALA-Get Measures by Panel ; 12 Jun 2007 2:57 PM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
Q
;
EN(DATA,OWNR,PLIEN) ;EP -- BQI GET MY MEASURES BY PANEL
;Description - Entry point for the panel
NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMSPL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMSPL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
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,'$D(@DATA) 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
S II=II+1,@DATA@(II)=$C(31)
Q
;
PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
NEW GMET,GHDR
; if the user is the owner of the panel, use the owner's display order
I $G(DUZ)=$G(OWNR),$O(^BQICARE(OWNR,1,PLIEN,21,0)) D NCOWN(OWNR,PLIEN,DFN) G EXIT
; if the user is a shared user, use the user's display order
I $G(DUZ)'=$G(OWNR),$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,0)) D NCDUZ(OWNR,PLIEN,DFN) G EXIT
; otherwise use the standard display order
D STAND()
;
EXIT ;
Q
;
NCOWN(OWNR,PLIEN,DFN) ;EP - Get customized display for an owner
; New (in dev) COWN
;Parameters
; DFN = Patient internal entry number
; HEADR = Record header
; STVW = Panel view definition internal entry number
; VALUE = Record value
NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,ORD,KEY
S VALUE=""
I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
I DFN'="" S VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
S HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
S IEN=0
F S IEN=$O(^BQICARE(OWNR,1,PLIEN,21,IEN)) Q:'IEN D
. NEW DA,IENS,STVW
. S DA(2)=OWNR,DA(1)=PLIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
. S STVW=$$GET1^DIQ(90505.13,IENS,.01,"I"),STVWCD=STVW
. S SIEN=$O(^BQI(90506.1,"B",STVW,"")) I SIEN="" Q
. I $$GET1^DIQ(90506.1,SIEN_",",.1,"I")=1 Q
. S KEY=$$GET1^DIQ(90506.1,SIEN_",",3.1,"E")
. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
. I $P(^BQI(90506.1,SIEN,0),U,10)=1 Q
. S HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
. ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
. ;I $P(^BQI(90506.1,SIEN,2),U,1)="R" S STVW=STVWCD D RMVL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders" S STVW=STVWCD D RMVL
. ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL^BQIGPRA1
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance" S STVW=STVWCD D GVAL^BQIGPRA1
. ;I $P(^BQI(90506.1,SIEN,2),U,1)="A" S STVW=SIEN D CVAL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Asthma" S STVW=SIEN D CVAL
. ;I $P(^BQI(90506.1,SIEN,2),U,1)="H" S STVW=SIEN D CVAL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="HIV/AIDS" S STVW=SIEN D CVAL
. S VALUE=VALUE_VAL_"^"
. S HEADR=HEADR_HDR_"^"
;
; 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'="" S II=II+1,@DATA@(II)=VALUE_$C(30)
;
Q
;
NCDUZ(OWNR,PLIEN,DFN) ;EP - Get customized display for a shared user
; New (in DEV) CDUZ
NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,KEY
S VALUE=""
I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
I DFN'="" S VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
S HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
S IEN=0
F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN)) Q:'IEN D
. NEW DA,IENS,STVW
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=IEN
. S IENS=$$IENS^DILF(.DA)
. S STVW=$$GET1^DIQ(90505.321,IENS,.01,"I"),STVWCD=STVW
. NEW SIEN
. S SIEN=$O(^BQI(90506.1,"B",STVW,"")) I SIEN="" Q
. I $$GET1^DIQ(90506.1,SIEN_",",.1,"I")=1 Q
. S KEY=$$GET1^DIQ(90506.1,SIEN_",",3.1,"E")
. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
. NEW STVW
. S STVW=SIEN
. S HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
. ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="D" S STVW=SIEN D CVAL
. ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="R" S STVW=STVWCD D RMVL
. ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="G" S STVW=STVWCD D GVAL^BQIGPRA1
. ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="A" S STVW=SIEN D CVAL
. ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="H" S STVW=SIEN D CVAL
. 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=STVWCD D RMVL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance" S STVW=STVWCD D GVAL^BQIGPRA1
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Asthma" S STVW=SIEN D CVAL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="HIV/AIDS" S STVW=SIEN D CVAL
. 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
;
STAND() ;EP - Get standard display
NEW IEN,HDR,VALUE,HEADR,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_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
S HEADR="I00010DFN^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 $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
. S STVW=IEN
. D CVAL
. S VALUE=VALUE_VAL_"^"
. S HEADR=HEADR_HDR_"^"
;
F TYP="G","R","A","H" S IEN="" D
. F S IEN=$O(^BQI(90506.1,"AC",TYP,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
.. S STVW=$P(^BQI(90506.1,IEN,0),U,1)
.. S HDR=$$GET1^DIQ(90506.1,IEN_",",.08,"E")
.. ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="R" D RMVL
.. ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="G" D GVAL^BQIGPRA1
.. ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="A" S STVW=IEN D CVAL
.. ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="H" S STVW=IEN D CVAL
.. I $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="Reminders" D RMVL
.. I $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="Performance" D GVAL^BQIGPRA1
.. I $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="Asthma" S STVW=IEN D CVAL
.. I $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="HIV/AIDS" S STVW=IEN D CVAL
.. 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,DUE
I DFN="" S VAL="",HDR="T00015"_STVW Q
S RIEN=$O(^BQIPAT(DFN,40,"B",STVW,"")) I RIEN="" S VAL="NDA" Q
S RDATA=$G(^BQIPAT(DFN,40,RIEN,0))
S CT=0
F I=2:1:4 S:$P(RDATA,U,I)'="" CT=CT+1
S HDR="T00015"_STVW
I CT=0 S VAL="N/A" Q
S DUE=$P(RDATA,U,4)
I $P(RDATA,U,3)'="",DUE="" S DUE=DT
I DUE>DT S VAL="F" Q
S ODT=$$FMADD^XLFDT(DT,-30)
I DUE<ODT S VAL="O" Q
S VAL="C"
;S VAL=$$FMTE^BQIUL1(DUE)
Q
BQIMSPL ;PRXM/HC/ALA-Get Measures by Panel ; 12 Jun 2007 2:57 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
+3 QUIT
+4 ;
EN(DATA,OWNR,PLIEN) ;EP -- BQI GET MY MEASURES BY PANEL
+1 ;Description - Entry point for the panel
+2 NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIMSPL",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMSPL D UNWIND^%ZTER"
+9 ;
+10 SET DFN=0
+11 IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))=""
DO PAT(.DATA,OWNR,PLIEN,"")
GOTO DONE
+12 ;
+13 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+14 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+15 DO PAT(.DATA,OWNR,PLIEN,DFN)
End DoDot:1
+16 ;
DONE ;
+1 IF II=0
IF '$DATA(@DATA)
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 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
+1 NEW GMET,GHDR
+2 ; if the user is the owner of the panel, use the owner's display order
+3 IF $GET(DUZ)=$GET(OWNR)
IF $ORDER(^BQICARE(OWNR,1,PLIEN,21,0))
DO NCOWN(OWNR,PLIEN,DFN)
GOTO EXIT
+4 ; if the user is a shared user, use the user's display order
+5 IF $GET(DUZ)'=$GET(OWNR)
IF $ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,0))
DO NCDUZ(OWNR,PLIEN,DFN)
GOTO EXIT
+6 ; otherwise use the standard display order
+7 DO STAND()
+8 ;
EXIT ;
+1 QUIT
+2 ;
NCOWN(OWNR,PLIEN,DFN) ;EP - Get customized display for an owner
+1 ; New (in dev) COWN
+2 ;Parameters
+3 ; DFN = Patient internal entry number
+4 ; HEADR = Record header
+5 ; STVW = Panel view definition internal entry number
+6 ; VALUE = Record value
+7 NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,ORD,KEY
+8 SET VALUE=""
+9 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+10 IF DFN'=""
SET VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
+11 SET HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
+12 SET IEN=0
+13 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,21,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+14 NEW DA,IENS,STVW
+15 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+16 SET STVW=$$GET1^DIQ(90505.13,IENS,.01,"I")
SET STVWCD=STVW
+17 SET SIEN=$ORDER(^BQI(90506.1,"B",STVW,""))
IF SIEN=""
QUIT
+18 IF $$GET1^DIQ(90506.1,SIEN_",",.1,"I")=1
QUIT
+19 SET KEY=$$GET1^DIQ(90506.1,SIEN_",",3.1,"E")
+20 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+21 IF $PIECE(^BQI(90506.1,SIEN,0),U,10)=1
QUIT
+22 SET HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
+23 ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
+24 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient"
SET STVW=SIEN
DO CVAL
+25 ;I $P(^BQI(90506.1,SIEN,2),U,1)="R" S STVW=STVWCD D RMVL
+26 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders"
SET STVW=STVWCD
DO RMVL
+27 ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL^BQIGPRA1
+28 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance"
SET STVW=STVWCD
DO GVAL^BQIGPRA1
+29 ;I $P(^BQI(90506.1,SIEN,2),U,1)="A" S STVW=SIEN D CVAL
+30 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Asthma"
SET STVW=SIEN
DO CVAL
+31 ;I $P(^BQI(90506.1,SIEN,2),U,1)="H" S STVW=SIEN D CVAL
+32 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="HIV/AIDS"
SET STVW=SIEN
DO CVAL
+33 SET VALUE=VALUE_VAL_"^"
+34 SET HEADR=HEADR_HDR_"^"
End DoDot:1
+35 ;
+36 ; remove trailing up-arrows
+37 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+38 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+39 ;
+40 IF DFN=""
SET VALUE=""
+41 ;
+42 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+43 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+44 ;
+45 QUIT
+46 ;
NCDUZ(OWNR,PLIEN,DFN) ;EP - Get customized display for a shared user
+1 ; New (in DEV) CDUZ
+2 NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,KEY
+3 SET VALUE=""
+4 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+5 IF DFN'=""
SET VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
+6 SET HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 NEW DA,IENS,STVW
+10 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=IEN
+11 SET IENS=$$IENS^DILF(.DA)
+12 SET STVW=$$GET1^DIQ(90505.321,IENS,.01,"I")
SET STVWCD=STVW
+13 NEW SIEN
+14 SET SIEN=$ORDER(^BQI(90506.1,"B",STVW,""))
IF SIEN=""
QUIT
+15 IF $$GET1^DIQ(90506.1,SIEN_",",.1,"I")=1
QUIT
+16 SET KEY=$$GET1^DIQ(90506.1,SIEN_",",3.1,"E")
+17 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+18 NEW STVW
+19 SET STVW=SIEN
+20 SET HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
+21 ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="D" S STVW=SIEN D CVAL
+22 ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="R" S STVW=STVWCD D RMVL
+23 ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="G" S STVW=STVWCD D GVAL^BQIGPRA1
+24 ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="A" S STVW=SIEN D CVAL
+25 ;I $P($G(^BQI(90506.1,SIEN,2)),U,1)="H" S STVW=SIEN D CVAL
+26 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient"
SET STVW=SIEN
DO CVAL
+27 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders"
SET STVW=STVWCD
DO RMVL
+28 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance"
SET STVW=STVWCD
DO GVAL^BQIGPRA1
+29 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Asthma"
SET STVW=SIEN
DO CVAL
+30 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="HIV/AIDS"
SET STVW=SIEN
DO CVAL
+31 SET VALUE=VALUE_VAL_"^"
+32 SET HEADR=HEADR_HDR_"^"
End DoDot:1
+33 ;
+34 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+35 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+36 ;
+37 IF DFN=""
SET VALUE=""
+38 ;
+39 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+40 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+41 ;
+42 QUIT
+43 ;
STAND() ;EP - Get standard display
+1 NEW IEN,HDR,VALUE,HEADR,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_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
+5 SET HEADR="I00010DFN^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 $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+9 SET STVW=IEN
+10 DO CVAL
+11 SET VALUE=VALUE_VAL_"^"
+12 SET HEADR=HEADR_HDR_"^"
End DoDot:1
+13 ;
+14 FOR TYP="G","R","A","H"
SET IEN=""
Begin DoDot:1
+15 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC",TYP,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+16 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+17 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+18 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+19 SET STVW=$PIECE(^BQI(90506.1,IEN,0),U,1)
+20 SET HDR=$$GET1^DIQ(90506.1,IEN_",",.08,"E")
+21 ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="R" D RMVL
+22 ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="G" D GVAL^BQIGPRA1
+23 ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="A" S STVW=IEN D CVAL
+24 ;I $P($G(^BQI(90506.1,IEN,2)),U,1)="H" S STVW=IEN D CVAL
+25 IF $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="Reminders"
DO RMVL
+26 IF $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="Performance"
DO GVAL^BQIGPRA1
+27 IF $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="Asthma"
SET STVW=IEN
DO CVAL
+28 IF $$GET1^DIQ(90506.1,IEN_",",3.01,"E")="HIV/AIDS"
SET STVW=IEN
DO CVAL
+29 SET VALUE=VALUE_VAL_"^"
+30 SET HEADR=HEADR_HDR_"^"
End DoDot:2
End DoDot:1
+31 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+32 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+33 ;
+34 IF DFN=""
SET VALUE=""
+35 ;
+36 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+37 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+38 QUIT
+39 ;
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,DUE
+2 IF DFN=""
SET VAL=""
SET HDR="T00015"_STVW
QUIT
+3 SET RIEN=$ORDER(^BQIPAT(DFN,40,"B",STVW,""))
IF RIEN=""
SET VAL="NDA"
QUIT
+4 SET RDATA=$GET(^BQIPAT(DFN,40,RIEN,0))
+5 SET CT=0
+6 FOR I=2:1:4
IF $PIECE(RDATA,U,I)'=""
SET CT=CT+1
+7 SET HDR="T00015"_STVW
+8 IF CT=0
SET VAL="N/A"
QUIT
+9 SET DUE=$PIECE(RDATA,U,4)
+10 IF $PIECE(RDATA,U,3)'=""
IF DUE=""
SET DUE=DT
+11 IF DUE>DT
SET VAL="F"
QUIT
+12 SET ODT=$$FMADD^XLFDT(DT,-30)
+13 IF DUE<ODT
SET VAL="O"
QUIT
+14 SET VAL="C"
+15 ;S VAL=$$FMTE^BQIUL1(DUE)
+16 QUIT
