BQIMTCRD.m

BQIMTCRD ;GDIT/HS/ALA-Get Definition Detail Data ; 04 Mar 2013  9:44 AM

 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 ;

 Q

 ;

EN(DATA,OWNR,PLIEN,CARE,PLIST) ;EP -- BQI GET MATCH CRITERIA DATA

 ;Description - Entry point for the panel

 ;Input Parameters

 ;  OWNR  - Owner of panel

 ;  PLIEN - Panel IEN

 ;  CARE  - Care Management

 ;  PLIST - List of DFNs (optional)

 ;

 NEW UID,II,X,BQIRM,VAL,HIEN,E,J,K,L,MAX,MIN,NAFLG,BN,LIST,BQI,DFN,CODE,CRIEN,QFL

 NEW CRN,CTYP,DOR,I,IFL,MTYP,NFLG,OCDT,PAT,RES,RESULT,RXIEN,RXN,STVCD,TYP,VISIT,TQFL

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIRGPL",UID))

 K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGPL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;S @DATA@(II)="I00010RESULT^T00030MSG"_$C(30)

 ;,@DATA@(1)="-1^No Data Available"_$C(30),NFLG=1

 I $L(CARE)=2 D  I CRN="" Q

 . S CRN=$O(^BQI(90506.5,"C",CARE,"")) I CRN="" Q

 . S TYP=CARE,CARE=$P(^BQI(90506.5,CRN,0),U,1)

 I $L(CARE)>2 D  I CRN="" Q

 . I CARE'?.N S CRN=$O(^BQI(90506.5,"B",CARE,"")) I CRN="" Q

 I CRN'="" S TYP=$P(^BQI(90506.5,CRN,0),U,2),CTYP=TYP,MTYP=$P(^(0),U,17)

 I CARE?.N S CRN=CARE,CARE=$P(^BQI(90506.5,CRN,0),U,1),TYP=$P(^BQI(90506.5,CRN,0),U,2),CTYP=TYP

 I CTYP="VS" S MTYP="VISIT"

 I MTYP="" Q

 ;S MTYP=$S(CTYP="PR":"PROB",CTYP="ME":"MED",CTYP="LA":"LAB",CTYP="IN":"INP",CTYP="CP":"CPT",CTYP="ER":"ERV",CTYP="AL":"ALGY",CTYP="ED":"EDUC",CTYP="RE":"REM",CTYP="VS":"VISIT",1:"") I MTYP="" Q

 S CRIEN=CRN

 ; 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,CARE,DFN)

 ;

 S DFN=0

 I $O(^BQICARE(OWNR,1,PLIEN,40,DFN))="" D PAT(.DATA,OWNR,PLIEN,CARE,"") 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,CARE,DFN)

 ;

DONE ;

 I II=0,$G(@DATA@(II))="" D

 . D HDR^BQIHEADR(OWNR,PLIEN,DFN,.BHEADR,.BVALUE)

 . S HEADR=$$TKO^BQIUL1(BHEADR,"^"),@DATA@(II)=HEADR_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

PAT(DATA,OWNR,PLIEN,CARE,DFN) ;EP - Build record by patient

 NEW MC,RIEN,VALUE,HEADR,CIEN,CDA,EXEC,DIS

 I $G(DFN)="" Q

 I DFN'="" D

 . S MC=$O(^BQICARE(OWNR,1,PLIEN,40,DFN,5,"B",MTYP,"")) I MC="" Q

 . S RIEN="",NFLG=0

 . F  S RIEN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN,5,MC,1,"B",RIEN)) Q:RIEN=""  D STND

 Q

 ;

STND ; Get standard display

 NEW IEN,HDR,VALUE,HEADR,SENS,HDOB,Y,STVW,TEXT,ORD,GMET,GHDR,RGIEN

 NEW GIEN,CIEN,ATAGN,ATAGNM,ATAGST,TYP,DIS,REMDESC

 S VALUE="",RGIEN=""

 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 HEADR=HEADR_"I00010HIDE_ASSOC_TAG_IEN^T00030HIDE_ASSOC_TAG_NAME^T00001HIDE_ASSOC_TAG_STATUS^"

 I CTYP="RE" S HEADR=HEADR_"T00010HIDE_REMCODE^T00015HIDE_REMMETH^"

 ;

 S RGIEN=$P(^BQI(90506.5,CRN,0),U,3) I RGIEN'="" S REG=$P(^BQI(90507,RGIEN,0),U,1)

 S ATAGN=$P(^BQI(90506.5,CRN,0),U,11),ATAGST=""

 I ATAGN="" S ATAGNM="{None}",ATAGST=""

 I ATAGN'="" S ATAGNM=$P(^BQI(90506.2,ATAGN,0),U,1)

 I DFN'="" S ATAGST=$$CTAG^BQITDUTL(DFN,ATAGNM)

 I ATAGST="" S ATAGN="",ATAGNM="{None}"

 S VALUE=VALUE_ATAGN_U_ATAGNM_U_ATAGST_U

 I CTYP="RE" D

 . S PRN=$O(^BQICARE(OWNR,1,PLIEN,15,"B","REMCODE",""))

 . S REMCODE=$P(^BQICARE(OWNR,1,PLIEN,15,PRN,0),U,2),REMDESC=$$VAL^BQIRMDR1(REMCODE)

 . S VALUE=VALUE_REMCODE_$C(29)_REMDESC_U_$$GET1^DIQ(9000001,DFN_",",4002,"E")_U

 ;

 ; Find IEN

 S IEN=""

 F  S IEN=$O(^BQI(90506.1,"AC",CTYP,IEN)) Q:IEN=""  D

 . I $P(^BQI(90506.1,IEN,0),U,6)'=".001" Q

 . S HEADR=HEADR_$P(^BQI(90506.1,IEN,0),U,8)_U

 . S STVW=IEN

 . N CRIEN  ;New'd variable since it gets used in executable calls

 . X ^BQI(90506.1,STVW,1)

 . S VALUE=VALUE_VAL_U

 ;

 ; 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 TQFL=0 D  G FIN:'TQFL

 . ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")

 . S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)

 . I LYIEN="" S TQFL=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'="" D

 .... S STVW=GIEN

 .... I $P($G(^BQI(90506.1,GIEN,0)),U,10)=1 Q

 .... D CVAL

 ... I GIEN="" S IFL=0 D  Q:IFL

 .... S STVCD=CODE

 .... D CKO

 ... S VALUE=VALUE_VAL_"^"

 ... S HEADR=HEADR_HDR_"^"

 ;

 ; If no template, check for customized

 I OWNR=DUZ D

 . S CIEN=$O(^BQICARE(OWNR,1,PLIEN,23,"B",CARE,""))

 . I CIEN'="" D

 .. S IEN=0

 .. I $O(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN))="" D DEF Q

 .. F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN)) Q:'IEN  D

 ... S CODE=$P(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",1) Q:CODE=""

 ... S GIEN=$O(^BQI(90506.1,"B",CODE,""))

 ... I GIEN'="" D

 .... S STVW=GIEN

 .... I $P($G(^BQI(90506.1,GIEN,0)),U,10)=1 Q

 .... D CVAL

 ... I GIEN="" S IFL=0 D  Q:IFL

 .... S STVCD=CODE

 .... D CKO

 ... S VALUE=VALUE_VAL_"^"

 ... S HEADR=HEADR_HDR_"^"

 . ;

 . ; If no customized, use default

 . I CIEN="" D DEF

 ;

 I OWNR'=DUZ D

 . S CIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,"B",CARE,""))

 . I CIEN'="" D

 .. S IEN=0

 .. I $O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN))="" D DEF Q

 .. F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN)) Q:'IEN  D

 ... S CODE=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",1) Q:CODE=""

 ... S GIEN=$O(^BQI(90506.1,"B",CODE,""))

 ... I GIEN'="" D

 .... S STVW=GIEN

 .... I $P($G(^BQI(90506.1,GIEN,0)),U,10)=1 Q

 .... K VAL

 .... D CVAL

 ... I GIEN="" S IFL=0 D  Q:IFL

 .... S STVCD=CODE

 .... D CKO

 ... S HEADR=HEADR_HDR_"^"

 ... ;I VALUE=$$TKO^BQIUL1(VAL,";") Q

 ... ;I VALUE=$P(VAL,";"),$P(VAL,";",2)'="" S VALUE=VALUE_$P(VAL,";",2)_"^"  Q

 ... S VALUE=VALUE_VAL_"^"

 . I CIEN="" D DEF

 ;

FIN ; Finish

 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'="" D

 . I CARE'="Lab Tests",$P($G(@DATA@(II)),$C(30),1)'=VALUE S II=II+1,@DATA@(II)=VALUE_$C(30) Q

 . I CARE="Lab Tests" 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,RCODE,RGIEN,RIEN,RHDR,MVALUE,CODE,GIEN

 S VAL=""

 ;S GIEN=$O(^BQI(90506.1,"B",STVW,"")) I GIEN="" Q

 S GIEN=STVW

 S FIL=$$GET1^DIQ(90506.1,GIEN_",",.05,"E")

 S FLD=$$GET1^DIQ(90506.1,GIEN_",",.06,"E")

 S EXEC=$$GET1^DIQ(90506.1,GIEN_",",1,"E")

 S HDR=$$GET1^DIQ(90506.1,GIEN_",",.08,"E")

 I $G(DFN)="" S VAL="" Q

 ;

 I $G(EXEC)'="" X EXEC Q

 ;

 S RCODE=$$GET1^DIQ(90506.1,GIEN_",",.01,"E")

 S RGIEN=$O(^BQI(90506.3,"AC",CRIEN,"")),VAL=""

 I RGIEN'="" D  Q:VAL'=""

 . S RIEN=$O(^BQI(90506.3,RGIEN,10,"AC",RCODE,""))

 . I RIEN'="",$P($G(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)="M" D  Q

 .. S RHDR=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,2),MVALUE=""

 .. NEW SNAME,SRIEN,SORD,SXREF,SIEN

 .. S SNAME=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,1)

 .. S SRIEN=$O(^BQI(90506.3,"B",SNAME,"")) I SRIEN="" Q

 .. S SORD="",SXREF=$S($D(^BQI(90506.3,SRIEN,10,"AF")):"AF",1:"C")

 .. F  S SORD=$O(^BQI(90506.3,SRIEN,10,SXREF,SORD)) Q:SORD=""  D

 ... S SIEN=""

 ... F  S SIEN=$O(^BQI(90506.3,SRIEN,10,SXREF,SORD,SIEN)) Q:SIEN=""  D

 .... I $P(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S" Q

 .... S CODE=$P(^BQI(90506.3,SRIEN,10,SIEN,0),U,7) I CODE="" Q

 .... S STVW=$O(^BQI(90506.1,"B",CODE,"")) I STVW="" Q

 .... I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q

 .... 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=RHDR

 .... I $G(DFN)="" S VAL="" Q

 .... ;

 .... I $G(EXEC)'="" X EXEC S VAL=VAL_$S(VAL'="":$C(10),1:"") Q

 .... I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")

 .... S VAL=VAL_$S(VAL'="":$C(10),1:"")

 ... S MVALUE=MVALUE_$$TKO^BQIUL1(VAL,$C(10))

 .. S VAL=MVALUE

 ;

 I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")

 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

 ;

DEF ; Default list of fields

 NEW CRIEN,TYP,ORD,IEN,STVW,KEY,CODE

 ; Check for any alternate display order which trumps source display order

 S CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 S TYP=$P(^BQI(90506.5,CRIEN,0),U,2)

 S ORD=""

 F  S ORD=$O(^BQI(90506.1,"AF",TYP,ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"AF",TYP,ORD,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 CODE=$P(^BQI(90506.1,IEN,0),U,1) Q:CODE=""

 ... I $P($G(^BQI(90506.1,IEN,0)),U,10)=1 Q

 ... S STVW=IEN

 ... D CVAL

 ... S VALUE=VALUE_VAL_"^"

 ... S HEADR=HEADR_HDR_"^"

 ;

 S CRIEN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")

 S TYP=$P(^BQI(90506.5,CRIEN,0),U,2)

 S ORD=""

 F  S ORD=$O(^BQI(90506.1,"AD",TYP,ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"AD",TYP,ORD,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 CODE=$P(^BQI(90506.1,IEN,0),U,1) Q:CODE=""

 ... I $P($G(^BQI(90506.1,IEN,0)),U,10)=1 Q

 ... S STVW=IEN

 ... D CVAL

 ... S VALUE=VALUE_VAL_"^"

 ... S HEADR=HEADR_HDR_"^"

 ;

 NEW CRIEN,TYP,ORD,IEN,STVW,KEY,CODE

 S CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 S TYP=$P(^BQI(90506.5,CRIEN,0),U,2),ATAGN=$P(^BQI(90506.5,CRIEN,0),U,11)

 S ORD=""

 F  S ORD=$O(^BQI(90506.1,"AD",TYP,ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"AD",TYP,ORD,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 CODE=$P(^BQI(90506.1,IEN,0),U,1) Q:CODE=""

 ... I $P($G(^BQI(90506.1,IEN,0)),U,10)=1 Q

 ... S STVW=IEN

 ... D CVAL

 ... S VALUE=VALUE_VAL_"^"

 ... S HEADR=HEADR_HDR_"^"

 ;

 ; if additional fields

 NEW CSIEN,STVCD

 S CSIEN=0

 F  S CSIEN=$O(^BQI(90506.5,CRIEN,10,CSIEN)) Q:'CSIEN  D

 . S STVCD=$P(^BQI(90506.5,CRIEN,10,CSIEN,0),U,1)

 . I $P(^BQI(90506.5,CRIEN,10,CSIEN,0),U,9)=1 Q

 . I $P(^BQI(90506.5,CRIEN,10,CSIEN,0),U,6)'="O" D

 .. D CKO

 .. S VALUE=VALUE_VAL_"^"

 .. S HEADR=HEADR_HDR_"^"

 ; If there is a dx tag, check for additional locally added columns

 I ATAGN'="" D

 . NEW CSIEN,STVCD

 . S CSIEN=0

 . F  S CSIEN=$O(^BQI(90506.2,ATAGN,6,CSIEN)) Q:'CSIEN  D

 .. S STVCD=$P(^BQI(90506.2,ATAGN,6,CSIEN,0),U,1)

 .. I $P(^BQI(90506.2,ATAGN,6,CSIEN,0),U,9)=1 Q

 .. I $P(^BQI(90506.2,ATAGN,6,CSIEN,0),U,6)'="O" D

 ... D CKO

 ... S VALUE=VALUE_VAL_"^"

 ... S HEADR=HEADR_HDR_"^"

 Q

 ;

CKO ; Check other

 NEW BQDTFRM

 ;I $P(STVCD,"_",1)'=CTYP Q

 S GIEN=$O(^BQI(90506.5,CRN,10,"B",STVCD,""))

 I GIEN'="" D  Q

 . ;Set HEADR

 . S DIS=$P(^BQI(90506.5,CRN,10,GIEN,0),U,5)

 . I $P(^BQI(90506.5,CRN,10,GIEN,0),U,9)=1 S IFL=1 Q

 . S BQDTFRM=$P(^BQI(90506.5,CRN,10,GIEN,0),U,8) S:BQDTFRM="" BQDTFRM="S"

 . ;Get Value

 . S RES=$$FND^BQICMUTL(CRN,GIEN,DFN)

 . ;I 'RES S HDR="T00025"_STVCD,VAL="" Q

 . I DIS="" S HDR="T00025"_STVCD,VAL=$P(RES,U,2)

 . I DIS="D" D

 .. S HDR="D00030"_STVCD

 .. S VAL=$S(BQDTFRM="S":$$FMTE^BQIUL1($P(RES,U,2)),1:$$FMTMDY^BQIUL1($P(RES,U,2)))

 . I DIS="R" S HDR="T00025"_STVCD,VAL=$P(RES,U,2)

 . I DIS="B" D

 .. S HDR="T00025"_STVCD

 .. S VAL=$S(BQDTFRM="S":$$FMTE^BQIUL1($P(RES,U,2)),1:$$FMTMDY^BQIUL1($P(RES,U,2)))_" "_$P(RES,U,3)

 . I VAL'="",$P(RES,U,7)="refusal" S VAL="Refused "_VAL

 I GIEN="",ATAGN'="" S GIEN=$O(^BQI(90506.2,ATAGN,6,"B",STVCD,""))

 I GIEN'="" D  Q

 . ;Set HEADR

 . S DIS=$P(^BQI(90506.2,ATAGN,6,GIEN,0),U,5)

 . I $P(^BQI(90506.2,ATAGN,6,GIEN,0),U,9)=1 S IFL=1 Q

 . S BQDTFRM=$P(^BQI(90506.2,ATAGN,6,GIEN,0),U,8) S:BQDTFRM="" BQDTFRM="S"

 . ;Get Value

 . S RES=$$FTAG^BQICMUTL(ATAGN,GIEN,DFN)

 . ;I 'RES S HDR="T00020"_STVCD,VAL="" Q

 . I DIS="D" D

 .. S HDR="T00020"_STVCD

 .. S VAL=$S(BQDTFRM="S":$$FMTE^BQIUL1($P(RES,U,2)),1:$$FMTMDY^BQIUL1($P(RES,U,2)))

 . I DIS="R" S HDR="T00025"_STVCD,VAL=$P(RES,U,3)

 . I DIS="B" D

 .. S HDR="T00025"_STVCD

 .. S VAL=$S(BQDTFRM="S":$$FMTE^BQIUL1($P(RES,U,2)),1:$$FMTMDY^BQIUL1($P(RES,U,2)))_" "_$P(RES,U,3)

 . I VAL'="",$P(RES,U,7)="refusal" S VAL="Refused "_VAL

 Q

 ;

SYM(RIEN) ;EP - Signs and symptoms

 NEW GN

 S RESULT=""

 S GN=0

 F  S GN=$O(^GMR(120.8,RIEN,10,GN)) Q:'GN  D

 . NEW DA,IENS

 . S DA(1)=RIEN,DA=GN,IENS=$$IENS^DILF(.DA)

 . S RESULT=RESULT_$$GET1^DIQ(120.81,IENS,.01,"E")_"; "

 S RESULT=1_U_$$TKO^BQIUL1(RESULT,"; ")

 Q

 ;

LPR(DFN) ;Last time problem list reviewed for patient

 NEW APCLBD,APCLED,APCLFORM

 S APCLBD=$$DATE^BQIUL1("T-12M"),APCLED=DT,APCLFORM="D"

 S RESULT=$$LASTPLR^APCLAPI6(DFN,APCLBD,APCLED,APCLFORM)

 Q

 ;

LAC(DFN) ;last time no active problems for patient

 NEW APCLBD,APCLED,APCLFORM

 S APCLBD=$$DATE^BQIUL1("T-12M"),APCLED=DT,APCLFORM="D"

 S RESULT=$$LASTNAP^APCLAPI6(DFN,APCLBD,APCLED,APCLFORM)

 Q

BQIMTCRD  ;GDIT/HS/ALA-Get Definition Detail Data ; 04 Mar 2013  9:44 AM

 +1       ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 +2       ;

 +3        QUIT 

 +4       ;

EN(DATA,OWNR,PLIEN,CARE,PLIST) ;EP -- BQI GET MATCH CRITERIA DATA

 +1       ;Description - Entry point for the panel

 +2       ;Input Parameters

 +3       ;  OWNR  - Owner of panel

 +4       ;  PLIEN - Panel IEN

 +5       ;  CARE  - Care Management

 +6       ;  PLIST - List of DFNs (optional)

 +7       ;

 +8        NEW UID,II,X,BQIRM,VAL,HIEN,E,J,K,L,MAX,MIN,NAFLG,BN,LIST,BQI,DFN,CODE,CRIEN,QFL

 +9        NEW CRN,CTYP,DOR,I,IFL,MTYP,NFLG,OCDT,PAT,RES,RESULT,RXIEN,RXN,STVCD,TYP,VISIT,TQFL

 +10       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +11       SET DATA=$NAME(^TMP("BQIRGPL",UID))

 +12       KILL @DATA

 +13      ;

 +14       SET II=0

 +15      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIRGPL D UNWIND^%ZTER"

 +16      ;S @DATA@(II)="I00010RESULT^T00030MSG"_$C(30)

 +17      ;,@DATA@(1)="-1^No Data Available"_$C(30),NFLG=1

 +18       IF $LENGTH(CARE)=2

               Begin DoDot:1

 +19               SET CRN=$ORDER(^BQI(90506.5,"C",CARE,""))

                   IF CRN=""

                       QUIT 

 +20               SET TYP=CARE

                   SET CARE=$PIECE(^BQI(90506.5,CRN,0),U,1)

               End DoDot:1

               IF CRN=""

                   QUIT 

 +21       IF $LENGTH(CARE)>2

               Begin DoDot:1

 +22               IF CARE'?.N

                       SET CRN=$ORDER(^BQI(90506.5,"B",CARE,""))

                       IF CRN=""

                           QUIT 

               End DoDot:1

               IF CRN=""

                   QUIT 

 +23       IF CRN'=""

               SET TYP=$PIECE(^BQI(90506.5,CRN,0),U,2)

               SET CTYP=TYP

               SET MTYP=$PIECE(^(0),U,17)

 +24       IF CARE?.N

               SET CRN=CARE

               SET CARE=$PIECE(^BQI(90506.5,CRN,0),U,1)

               SET TYP=$PIECE(^BQI(90506.5,CRN,0),U,2)

               SET CTYP=TYP

 +25       IF CTYP="VS"

               SET MTYP="VISIT"

 +26       IF MTYP=""

               QUIT 

 +27      ;S MTYP=$S(CTYP="PR":"PROB",CTYP="ME":"MED",CTYP="LA":"LAB",CTYP="IN":"INP",CTYP="CP":"CPT",CTYP="ER":"ERV",CTYP="AL":"ALGY",CTYP="ED":"EDUC",CTYP="RE":"REM",CTYP="VS":"VISIT",1:"") I MTYP="" Q

 +28       SET CRIEN=CRN

 +29      ; If a list of DFNs, process them instead of entire panel

 +30       IF $DATA(PLIST)>0

               Begin DoDot:1

 +31               IF $DATA(PLIST)>1

                       Begin DoDot:2

 +32                       SET LIST=""

                           SET BN=""

 +33                       FOR 

                               SET BN=$ORDER(PLIST(BN))

                               IF BN=""

                                   QUIT 

                               SET LIST=LIST_PLIST(BN)

 +34                       KILL PLIST

                           SET PLIST=LIST

                       End DoDot:2

 +35               FOR BQI=1:1

                       SET DFN=$PIECE(PLIST,$CHAR(28),BQI)

                       IF DFN=""

                           QUIT 

                       Begin DoDot:2

 +36                       IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"

                               QUIT 

 +37                       DO PAT(.DATA,OWNR,PLIEN,CARE,DFN)

                       End DoDot:2

               End DoDot:1

               GOTO DONE

 +38      ;

 +39       SET DFN=0

 +40       IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))=""

               DO PAT(.DATA,OWNR,PLIEN,CARE,"")

               GOTO DONE

 +41      ;

 +42       FOR 

               SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))

               IF 'DFN

                   QUIT 

               Begin DoDot:1

 +43               IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"

                       QUIT 

 +44               DO PAT(.DATA,OWNR,PLIEN,CARE,DFN)

               End DoDot:1

 +45      ;

DONE      ;

 +1        IF II=0

               IF $GET(@DATA@(II))=""

                   Begin DoDot:1

 +2                    DO HDR^BQIHEADR(OWNR,PLIEN,DFN,.BHEADR,.BVALUE)

 +3                    SET HEADR=$$TKO^BQIUL1(BHEADR,"^")

                       SET @DATA@(II)=HEADR_$CHAR(30)

                   End DoDot:1

 +4        SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +5        QUIT 

 +6       ;

PAT(DATA,OWNR,PLIEN,CARE,DFN) ;EP - Build record by patient