BTPWPNLV ;VNGT/HS/ALA-CMET Panel ; 03 Aug 2009 4:07 PM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
EN(DATA,OWNR,PLIEN,VIEW,STATE,PLIST,CMLST,PARMS) ;EP - BTPW GET EVENTS BY PANEL
;
; Input
; OWNR - Owner
; PLIEN - Panel IEN
; VIEW - (Q)ueued, (T)racked, (N) Planned
; STATE - State or status
; PLIST - List of DFNs to include
; CMLST - List of file IENs to include (optional)
; PARMS - List of panel filters - Event Type Only (See BTPWPEVF for details)
;
NEW UID,II,STATUS,BDT,EDT,CATLST,COMM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPNLV",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPNLV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S STATE=$G(STATE,"")
;
;Define filter variables
I $G(VIEW)="Q" D FINIT^BTPWPEVF(.STATUS,.BDT,.EDT,.CATLST,.COMM,.PARMS)
;
;Check for IEN List
I $G(CMLST)]"" D
. N I,IEN
. F I=1:1:$L(CMLST,$C(29)) S IEN=$P(CMLST,$C(29),I) I IEN]"" S CMLST(IEN)=""
;
; If a list of CMIENs, process them instead of entire panel
I $O(CMLST(""))]"" D G DONE
. N CIEN
. S CIEN="" F S CIEN=$O(CMLST(CIEN)) Q:CIEN="" D
.. ;
.. ;Get DFN
.. I VIEW="Q" S DFN=$$GET1^DIQ(90629,CIEN_",",".02","I")
.. E S DFN=$$GET1^DIQ(90620,CIEN_",",".02","I")
.. Q:DFN=""
.. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
.. D PAT(.DATA,OWNR,PLIEN,STATE,DFN,.CMLST)
;
; If a list of DFNs, process them instead of entire panel
I $D(PLIST)>0 D G DONE
. N BN,BQI
. 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,STATE,DFN,.CMLST)
;
S DFN=0
I $O(^BQICARE(OWNR,1,PLIEN,40,DFN))="" D PAT(.DATA,OWNR,PLIEN,STATE,"",.CMLST) 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,STATE,DFN,.CMLST)
;
DONE ;
I II=0,'$D(@DATA) D PAT(.DATA,OWNR,PLIEN,STATE,"",.CMLST)
S II=II+1,@DATA@(II)=$C(31)
Q
;
PAT(DATA,OWNR,PLIEN,STATE,DFN,CMLST) ;EP - Build record by patient
; Get standard display
NEW IEN,HDR,HEADR,SENS,HDOB,Y,STVW,TEXT,ORD,GMET,GHDR,RGIEN,CRIEN,CARE,CTYP
NEW GIEN,CIEN,SVALUE,VALUE,VAL
S VALUE="",RGIEN="",STATE=$G(STATE,"")
I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
I DFN'="" S SVALUE=DFN_U_$$SENS^BQIULPT(DFN)_U_$$FLG^BQIULPT(OWNR,PLIEN,DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
S HEADR="I00010HIDE_DFN^T00001SENS_FLAG^T00001FLAG_INDICATOR^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^I00010HIDE_CMET_IEN^"
S HEADR=HEADR_"I00010HIDE_VISIT_IEN^I00010HIDE_EVENTTYPE_IEN^"
;
;Custom Header
I VIEW="Q" S HEADR=HEADR_"T00060HIDE_BTPWQENM^D00015HIDE_BTPWQEDT^T00020HIDE_BTPWQSTS^"
E S HEADR=HEADR_"T00060HIDE_BTPWTENM^D00015HIDE_BTPWTEDT^T00015HIDE_BTPWTSTA^T00010HIDE_PREVIOUS_EVENT^"
;
S CARE="Event Tracking"
I VIEW="Q" S CARE="Events"
I VIEW="T" S CARE="Tracked Events"
I VIEW="N" S CARE="Followup Events"
S CRIEN=$O(^BQI(90506.5,"B",CARE,"")),CTYP=$P(^BQI(90506.5,CRIEN,0),U,2)
;
I DFN="" D FND Q
;
I VIEW="Q" D
. N QIEN,TIEN
. S (QIEN,TIEN)=""
. ;
. ;Process individual (input) events
. I $O(CMLST(""))]"" D Q
.. F S QIEN=$O(CMLST(QIEN)) Q:QIEN="" D
... ;
... ;Panel Filters
... Q:'$$PEFIL^BTPWPEVF(STATUS,BDT,EDT,.CATLST,.COMM,QIEN)
... ;
... S TIEN=$P($G(^BTPWQ(QIEN,0)),U,14)
... ;
... ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATUS
... S VALUE=SVALUE_QIEN_U_$$GET1^DIQ(90629,QIEN_",",".04","I")_U_$$GET1^DIQ(90629,QIEN_",",".01","I")
... S VALUE=VALUE_U_$$GET1^DIQ(90629,QIEN_",",".01","E")
... S VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",".03","I"))_U_$$GET1^DIQ(90629,QIEN_",",".08","E")_U
... ;
... D FND
. ;
. ;Process entire panel
. I STATE'="" F S QIEN=$O(^BTPWQ("AE",DFN,STATE,QIEN)) Q:QIEN="" D
.. ;
.. ;Panel Filters
.. Q:'$$PEFIL^BTPWPEVF(STATUS,BDT,EDT,.CATLST,.COMM,QIEN)
.. ;
.. S TIEN=$P($G(^BTPWQ(QIEN,0)),U,14)
.. ;
.. ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATUS
.. S VALUE=SVALUE_QIEN_U_$$GET1^DIQ(90629,QIEN_",",".04","I")_U_$$GET1^DIQ(90629,QIEN_",",".01","I")
.. S VALUE=VALUE_U_$$GET1^DIQ(90629,QIEN_",",".01","E")
.. S VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",".03","I"))_U_$$GET1^DIQ(90629,QIEN_",",".08","E")_U
.. ;
.. D FND
. I STATE="" F S QIEN=$O(^BTPWQ("AD",DFN,QIEN)) Q:QIEN="" D
.. ;
.. ;Panel Filters
.. Q:'$$PEFIL^BTPWPEVF(STATUS,BDT,EDT,.CATLST,.COMM,QIEN)
.. ;
.. S TIEN=$P($G(^BTPWQ(QIEN,0)),U,14)
.. ;
.. ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATUS
.. S VALUE=SVALUE_QIEN_U_$$GET1^DIQ(90629,QIEN_",",".04","I")_U_$$GET1^DIQ(90629,QIEN_",",".01","I")
.. S VALUE=VALUE_U_$$GET1^DIQ(90629,QIEN_",",".01","E")
.. S VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",".03","I"))_U_$$GET1^DIQ(90629,QIEN_",",".08","E")_U
.. ;
.. D FND
;
I VIEW="T"!(VIEW="N") D
. N QIEN,TIEN,STATUS
. S (QIEN,TIEN)=""
. ;
. ;Process individual (input) events
. I $O(CMLST(""))]"" D Q
.. F S TIEN=$O(CMLST(TIEN)) Q:TIEN="" D
... ;
... ; Don't show 'future' records
... I $P($G(^BTPWP(TIEN,1)),U,1)="F",VIEW'="N" Q
... I $P($G(^BTPWP(TIEN,1)),U,1)'="F",VIEW="N" Q
... S QIEN=$P($G(^BTPWP(TIEN,0)),U,14)
... ;
... ;Status Check - Must be Tracked
... I QIEN]"" S STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I") I STATUS'="",STATUS'="T" Q
... ;
... ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATE, PREVIOUS EVENT
... S VALUE=SVALUE_TIEN_U_$$GET1^DIQ(90620,TIEN_",",".04","I")_U_$$GET1^DIQ(90620,TIEN_",",".01","I")
... S VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".01","E")
... S VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",".03","I"))_U_$$GET1^DIQ(90620,TIEN_",","1.01","E")
... S VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".11","I")_U
... ;
... D FND
. ;
. ;Process entire panel
. I STATE'="" F S TIEN=$O(^BTPWP("AE",DFN,STATE,TIEN)) Q:TIEN="" D
.. ;
.. S QIEN=$P($G(^BTPWP(TIEN,0)),U,14)
.. ;
.. ;Status Check - Must be Tracked
.. I QIEN]"" S STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I") I STATUS'="",STATUS'="T" Q
.. ;
.. ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATE
.. S VALUE=SVALUE_TIEN_U_$$GET1^DIQ(90620,TIEN_",",".04","I")_U_$$GET1^DIQ(90620,TIEN_",",".01","I")
.. S VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".01","E")
.. S VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",".03","I"))_U_$$GET1^DIQ(90620,TIEN_",","1.01","E")
.. S VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".11","I")_U
.. ;
.. D FND
. I STATE="" F S TIEN=$O(^BTPWP("AD",DFN,TIEN)) Q:TIEN="" D
.. ;
.. ; Don't show 'future' records
.. I $P($G(^BTPWP(TIEN,1)),U,1)="F",VIEW'="N" Q
.. I $P($G(^BTPWP(TIEN,1)),U,1)'="F",VIEW="N" Q
.. S QIEN=$P($G(^BTPWP(TIEN,0)),U,14)
.. ;
.. ;Status Check - Must be Tracked
.. I QIEN]"" S STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I") I STATUS'="",STATUS'="T" Q
.. ;
.. ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATE
.. S VALUE=SVALUE_TIEN_U_$$GET1^DIQ(90620,TIEN_",",".04","I")_U_$$GET1^DIQ(90620,TIEN_",",".01","I")
.. S VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".01","E")
.. S VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",".03","I"))_U_$$GET1^DIQ(90620,TIEN_",","1.01","E")
.. S VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".11","I")_U
.. ;
.. D FND
Q
;
FND ; Check for template
NEW DA,IENS,TEMPL,LYIEN,DOR,LIST
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'="" D G FIN
. ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
. S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
. I LYIEN="" 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
... D CVAL
... 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 GIEN=$P(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",1) Q:GIEN=""
... ;S STVW=GIEN
... S STVW=$O(^BQI(90506.1,"B",GIEN,"")) Q:STVW=""
... D CVAL
... 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
.. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN)) Q:'IEN D
... S GIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",1)
... ;S STVW=GIEN
... S STVW=$O(^BQI(90506.1,"B",GIEN,"")) Q:STVW=""
... D CVAL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
. 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 $P($G(@DATA@(II)),$C(30),1)'=VALUE S II=II+1,@DATA@(II)=VALUE_$C(30)
I $G(@DATA@(0))="" S @DATA@(0)=HEADR_$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
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
;
S RCODE=$$GET1^DIQ(90506.1,STVW_",",.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 VALUE=VALUE_VAL_$S(VAL'="":$C(10),1:"")
.... S VAL=VALUE
... S MVALUE=MVALUE_$$TKO^BQIUL1(VAL,$C(10))
... ;S MVALUE=MVALUE_VAL
.. 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
S II=II+1,@DATA@(II)=$C(31)
Q
;
DEF ; Default list of fields
NEW CRIEN,TYP,ORD,IEN,STVW,DEFF
; 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
.. 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 TYP="D",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
.. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
... S STVW=IEN
... D CVAL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
;
NEW CRIEN,TYP,ORD,IEN,STVW
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,"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
.. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
... S STVW=IEN
... D CVAL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
Q
;
BTPWPNLV ;VNGT/HS/ALA-CMET Panel ; 03 Aug 2009 4:07 PM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
EN(DATA,OWNR,PLIEN,VIEW,STATE,PLIST,CMLST,PARMS) ;EP - BTPW GET EVENTS BY PANEL
+1 ;
+2 ; Input
+3 ; OWNR - Owner
+4 ; PLIEN - Panel IEN
+5 ; VIEW - (Q)ueued, (T)racked, (N) Planned
+6 ; STATE - State or status
+7 ; PLIST - List of DFNs to include
+8 ; CMLST - List of file IENs to include (optional)
+9 ; PARMS - List of panel filters - Event Type Only (See BTPWPEVF for details)
+10 ;
+11 NEW UID,II,STATUS,BDT,EDT,CATLST,COMM
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("BTPWPNLV",UID))
+14 KILL @DATA
+15 ;
+16 SET II=0
+17 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPNLV D UNWIND^%ZTER"
+18 ;
+19 SET STATE=$GET(STATE,"")
+20 ;
+21 ;Define filter variables
+22 IF $GET(VIEW)="Q"
DO FINIT^BTPWPEVF(.STATUS,.BDT,.EDT,.CATLST,.COMM,.PARMS)
+23 ;
+24 ;Check for IEN List
+25 IF $GET(CMLST)]""
Begin DoDot:1
+26 NEW I,IEN
+27 FOR I=1:1:$LENGTH(CMLST,$CHAR(29))
SET IEN=$PIECE(CMLST,$CHAR(29),I)
IF IEN]""
SET CMLST(IEN)=""
End DoDot:1
+28 ;
+29 ; If a list of CMIENs, process them instead of entire panel
+30 IF $ORDER(CMLST(""))]""
Begin DoDot:1
+31 NEW CIEN
+32 SET CIEN=""
FOR
SET CIEN=$ORDER(CMLST(CIEN))
IF CIEN=""
QUIT
Begin DoDot:2
+33 ;
+34 ;Get DFN
+35 IF VIEW="Q"
SET DFN=$$GET1^DIQ(90629,CIEN_",",".02","I")
+36 IF '$TEST
SET DFN=$$GET1^DIQ(90620,CIEN_",",".02","I")
+37 IF DFN=""
QUIT
+38 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+39 DO PAT(.DATA,OWNR,PLIEN,STATE,DFN,.CMLST)
End DoDot:2
End DoDot:1
GOTO DONE
+40 ;
+41 ; If a list of DFNs, process them instead of entire panel
+42 IF $DATA(PLIST)>0
Begin DoDot:1
+43 NEW BN,BQI
+44 IF $DATA(PLIST)>1
Begin DoDot:2
+45 SET LIST=""
SET BN=""
+46 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+47 KILL PLIST
SET PLIST=LIST
End DoDot:2
+48 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:2
+49 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+50 DO PAT(.DATA,OWNR,PLIEN,STATE,DFN,.CMLST)
End DoDot:2
End DoDot:1
GOTO DONE
+51 ;
+52 SET DFN=0
+53 IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))=""
DO PAT(.DATA,OWNR,PLIEN,STATE,"",.CMLST)
GOTO DONE
+54 ;
+55 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+56 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+57 DO PAT(.DATA,OWNR,PLIEN,STATE,DFN,.CMLST)
End DoDot:1
+58 ;
DONE ;
+1 IF II=0
IF '$DATA(@DATA)
DO PAT(.DATA,OWNR,PLIEN,STATE,"",.CMLST)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
PAT(DATA,OWNR,PLIEN,STATE,DFN,CMLST) ;EP - Build record by patient
+1 ; Get standard display
+2 NEW IEN,HDR,HEADR,SENS,HDOB,Y,STVW,TEXT,ORD,GMET,GHDR,RGIEN,CRIEN,CARE,CTYP
+3 NEW GIEN,CIEN,SVALUE,VALUE,VAL
+4 SET VALUE=""
SET RGIEN=""
SET STATE=$GET(STATE,"")
+5 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+6 IF DFN'=""
SET SVALUE=DFN_U_$$SENS^BQIULPT(DFN)_U_$$FLG^BQIULPT(OWNR,PLIEN,DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
+7 SET HEADR="I00010HIDE_DFN^T00001SENS_FLAG^T00001FLAG_INDICATOR^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^I00010HIDE_CMET_IEN^"
+8 SET HEADR=HEADR_"I00010HIDE_VISIT_IEN^I00010HIDE_EVENTTYPE_IEN^"
+9 ;
+10 ;Custom Header
+11 IF VIEW="Q"
SET HEADR=HEADR_"T00060HIDE_BTPWQENM^D00015HIDE_BTPWQEDT^T00020HIDE_BTPWQSTS^"
+12 IF '$TEST
SET HEADR=HEADR_"T00060HIDE_BTPWTENM^D00015HIDE_BTPWTEDT^T00015HIDE_BTPWTSTA^T00010HIDE_PREVIOUS_EVENT^"
+13 ;
+14 SET CARE="Event Tracking"
+15 IF VIEW="Q"
SET CARE="Events"
+16 IF VIEW="T"
SET CARE="Tracked Events"
+17 IF VIEW="N"
SET CARE="Followup Events"
+18 SET CRIEN=$ORDER(^BQI(90506.5,"B",CARE,""))
SET CTYP=$PIECE(^BQI(90506.5,CRIEN,0),U,2)
+19 ;
+20 IF DFN=""
DO FND
QUIT
+21 ;
+22 IF VIEW="Q"
Begin DoDot:1
+23 NEW QIEN,TIEN
+24 SET (QIEN,TIEN)=""
+25 ;
+26 ;Process individual (input) events
+27 IF $ORDER(CMLST(""))]""
Begin DoDot:2
+28 FOR
SET QIEN=$ORDER(CMLST(QIEN))
IF QIEN=""
QUIT
Begin DoDot:3
+29 ;
+30 ;Panel Filters
+31 IF '$$PEFIL^BTPWPEVF(STATUS,BDT,EDT,.CATLST,.COMM,QIEN)
QUIT
+32 ;
+33 SET TIEN=$PIECE($GET(^BTPWQ(QIEN,0)),U,14)
+34 ;
+35 ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATUS
+36 SET VALUE=SVALUE_QIEN_U_$$GET1^DIQ(90629,QIEN_",",".04","I")_U_$$GET1^DIQ(90629,QIEN_",",".01","I")
+37 SET VALUE=VALUE_U_$$GET1^DIQ(90629,QIEN_",",".01","E")
+38 SET VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",".03","I"))_U_$$GET1^DIQ(90629,QIEN_",",".08","E")_U
+39 ;
+40 DO FND
End DoDot:3
End DoDot:2
QUIT
+41 ;
+42 ;Process entire panel
+43 IF STATE'=""
FOR
SET QIEN=$ORDER(^BTPWQ("AE",DFN,STATE,QIEN))
IF QIEN=""
QUIT
Begin DoDot:2
+44 ;
+45 ;Panel Filters
+46 IF '$$PEFIL^BTPWPEVF(STATUS,BDT,EDT,.CATLST,.COMM,QIEN)
QUIT
+47 ;
+48 SET TIEN=$PIECE($GET(^BTPWQ(QIEN,0)),U,14)
+49 ;
+50 ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATUS
+51 SET VALUE=SVALUE_QIEN_U_$$GET1^DIQ(90629,QIEN_",",".04","I")_U_$$GET1^DIQ(90629,QIEN_",",".01","I")
+52 SET VALUE=VALUE_U_$$GET1^DIQ(90629,QIEN_",",".01","E")
+53 SET VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",".03","I"))_U_$$GET1^DIQ(90629,QIEN_",",".08","E")_U
+54 ;
+55 DO FND
End DoDot:2
+56 IF STATE=""
FOR
SET QIEN=$ORDER(^BTPWQ("AD",DFN,QIEN))
IF QIEN=""
QUIT
Begin DoDot:2
+57 ;
+58 ;Panel Filters
+59 IF '$$PEFIL^BTPWPEVF(STATUS,BDT,EDT,.CATLST,.COMM,QIEN)
QUIT
+60 ;
+61 SET TIEN=$PIECE($GET(^BTPWQ(QIEN,0)),U,14)
+62 ;
+63 ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATUS
+64 SET VALUE=SVALUE_QIEN_U_$$GET1^DIQ(90629,QIEN_",",".04","I")_U_$$GET1^DIQ(90629,QIEN_",",".01","I")
+65 SET VALUE=VALUE_U_$$GET1^DIQ(90629,QIEN_",",".01","E")
+66 SET VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",".03","I"))_U_$$GET1^DIQ(90629,QIEN_",",".08","E")_U
+67 ;
+68 DO FND
End DoDot:2
End DoDot:1
+69 ;
+70 IF VIEW="T"!(VIEW="N")
Begin DoDot:1
+71 NEW QIEN,TIEN,STATUS
+72 SET (QIEN,TIEN)=""
+73 ;
+74 ;Process individual (input) events
+75 IF $ORDER(CMLST(""))]""
Begin DoDot:2
+76 FOR
SET TIEN=$ORDER(CMLST(TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+77 ;
+78 ; Don't show 'future' records
+79 IF $PIECE($GET(^BTPWP(TIEN,1)),U,1)="F"
IF VIEW'="N"
QUIT
+80 IF $PIECE($GET(^BTPWP(TIEN,1)),U,1)'="F"
IF VIEW="N"
QUIT
+81 SET QIEN=$PIECE($GET(^BTPWP(TIEN,0)),U,14)
+82 ;
+83 ;Status Check - Must be Tracked
+84 IF QIEN]""
SET STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I")
IF STATUS'=""
IF STATUS'="T"
QUIT
+85 ;
+86 ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATE, PREVIOUS EVENT
+87 SET VALUE=SVALUE_TIEN_U_$$GET1^DIQ(90620,TIEN_",",".04","I")_U_$$GET1^DIQ(90620,TIEN_",",".01","I")
+88 SET VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".01","E")
+89 SET VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",".03","I"))_U_$$GET1^DIQ(90620,TIEN_",","1.01","E")
+90 SET VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".11","I")_U
+91 ;
+92 DO FND
End DoDot:3
End DoDot:2
QUIT
+93 ;
+94 ;Process entire panel
+95 IF STATE'=""
FOR
SET TIEN=$ORDER(^BTPWP("AE",DFN,STATE,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+96 ;
+97 SET QIEN=$PIECE($GET(^BTPWP(TIEN,0)),U,14)
+98 ;
+99 ;Status Check - Must be Tracked
+100 IF QIEN]""
SET STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I")
IF STATUS'=""
IF STATUS'="T"
QUIT
+101 ;
+102 ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATE
+103 SET VALUE=SVALUE_TIEN_U_$$GET1^DIQ(90620,TIEN_",",".04","I")_U_$$GET1^DIQ(90620,TIEN_",",".01","I")
+104 SET VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".01","E")
+105 SET VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",".03","I"))_U_$$GET1^DIQ(90620,TIEN_",","1.01","E")
+106 SET VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".11","I")_U
+107 ;
+108 DO FND
End DoDot:2
+109 IF STATE=""
FOR
SET TIEN=$ORDER(^BTPWP("AD",DFN,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+110 ;
+111 ; Don't show 'future' records
+112 IF $PIECE($GET(^BTPWP(TIEN,1)),U,1)="F"
IF VIEW'="N"
QUIT
+113 IF $PIECE($GET(^BTPWP(TIEN,1)),U,1)'="F"
IF VIEW="N"
QUIT
+114 SET QIEN=$PIECE($GET(^BTPWP(TIEN,0)),U,14)
+115 ;
+116 ;Status Check - Must be Tracked
+117 IF QIEN]""
SET STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I")
IF STATUS'=""
IF STATUS'="T"
QUIT
+118 ;
+119 ;Tack on CMET IEN, VISIT IEN, CATEGORY IEN, TICKLER_INDICATOR, EVENT NAME, EVENT DATE, STATE
+120 SET VALUE=SVALUE_TIEN_U_$$GET1^DIQ(90620,TIEN_",",".04","I")_U_$$GET1^DIQ(90620,TIEN_",",".01","I")
+121 SET VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".01","E")
+122 SET VALUE=VALUE_U_$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",".03","I"))_U_$$GET1^DIQ(90620,TIEN_",","1.01","E")
+123 SET VALUE=VALUE_U_$$GET1^DIQ(90620,TIEN_",",".11","I")_U
+124 ;
+125 DO FND
End DoDot:2
End DoDot:1
+126 QUIT
+127 ;
FND ; Check for template
+1 NEW DA,IENS,TEMPL,LYIEN,DOR,LIST
+2 SET TEMPL=""
+3 IF OWNR'=DUZ
Begin DoDot:1
+4 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
+5 IF DA=""
QUIT
+6 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET IENS=$$IENS^DILF(.DA)
+7 SET TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
End DoDot:1
+8 IF OWNR=DUZ
Begin DoDot:1
+9 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
+10 IF DA=""
QUIT
+11 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET IENS=$$IENS^DILF(.DA)
+12 SET TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
End DoDot:1
+13 ;
+14 ; If template, use it
+15 IF TEMPL'=""
Begin DoDot:1
+16 ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
+17 SET LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
+18 IF LYIEN=""
QUIT
+19 SET DOR=""
+20 FOR
SET DOR=$ORDER(^BQICARE(DUZ,15,LYIEN,1,"C",DOR))
IF DOR=""
QUIT
Begin DoDot:2
+21 SET IEN=""
+22 FOR
SET IEN=$ORDER(^BQICARE(DUZ,15,LYIEN,1,"C",DOR,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+23 SET CODE=$PIECE(^BQICARE(DUZ,15,LYIEN,1,IEN,0),U,1)
+24 SET GIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF GIEN=""
QUIT
+25 SET STVW=GIEN
+26 DO CVAL
+27 SET VALUE=VALUE_VAL_"^"
+28 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
End DoDot:1
GOTO FIN
+29 ;
+30 ; If no template, check for customized
+31 IF OWNR=DUZ
Begin DoDot:1
+32 SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,"B",CARE,""))
+33 IF CIEN'=""
Begin DoDot:2
+34 SET IEN=0
+35 IF $ORDER(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN))=""
DO DEF
QUIT
+36 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+37 SET GIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",1)
IF GIEN=""
QUIT
+38 ;S STVW=GIEN
+39 SET STVW=$ORDER(^BQI(90506.1,"B",GIEN,""))
IF STVW=""
QUIT
+40 DO CVAL
+41 SET VALUE=VALUE_VAL_"^"
+42 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
+43 ;
+44 ; If no customized, use default
+45 IF CIEN=""
DO DEF
End DoDot:1
+46 ;
+47 IF OWNR'=DUZ
Begin DoDot:1
+48 SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,"B",CARE,""))
+49 IF CIEN'=""
Begin DoDot:2
+50 SET IEN=0
+51 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+52 SET GIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",1)
+53 ;S STVW=GIEN
+54 SET STVW=$ORDER(^BQI(90506.1,"B",GIEN,""))
IF STVW=""
QUIT
+55 DO CVAL
+56 SET VALUE=VALUE_VAL_"^"
+57 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
+58 IF CIEN=""
DO DEF
End DoDot:1
+59 ;
FIN ; Finish
+1 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+2 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+3 ;
+4 IF DFN=""
SET VALUE=""
+5 ;
+6 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+7 IF VALUE'=""
Begin DoDot:1
+8 IF $PIECE($GET(@DATA@(II)),$CHAR(30),1)'=VALUE
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
End DoDot:1
+9 IF $GET(@DATA@(0))=""
SET @DATA@(0)=HEADR_$CHAR(30)
+10 QUIT
+11 ;
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,RCODE,RGIEN,RIEN,RHDR,MVALUE,CODE
+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 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+16 QUIT
+17 ;
+18 SET RCODE=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
+19 SET RGIEN=$ORDER(^BQI(90506.3,"AC",CRIEN,""))
SET VAL=""
+20 IF RGIEN'=""
Begin DoDot:1
+21 SET RIEN=$ORDER(^BQI(90506.3,RGIEN,10,"AC",RCODE,""))
+22 IF RIEN'=""
IF $PIECE($GET(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)="M"
Begin DoDot:2
+23 SET RHDR=$PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,2)
SET MVALUE=""
+24 NEW SNAME,SRIEN,SORD,SXREF,SIEN
+25 SET SNAME=$PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,1)
+26 SET SRIEN=$ORDER(^BQI(90506.3,"B",SNAME,""))
IF SRIEN=""
QUIT
+27 SET SORD=""
SET SXREF=$SELECT($DATA(^BQI(90506.3,SRIEN,10,"AF")):"AF",1:"C")
+28 FOR
SET SORD=$ORDER(^BQI(90506.3,SRIEN,10,SXREF,SORD))
IF SORD=""
QUIT
Begin DoDot:3
+29 SET SIEN=""
+30 FOR
SET SIEN=$ORDER(^BQI(90506.3,SRIEN,10,SXREF,SORD,SIEN))
IF SIEN=""
QUIT
Begin DoDot:4
+31 IF $PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S"
QUIT
+32 SET CODE=$PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,7)
IF CODE=""
QUIT
+33 SET STVW=$ORDER(^BQI(90506.1,"B",CODE,""))
IF STVW=""
QUIT
+34 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+35 NEW FIL,FLD,EXEC
+36 SET FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
+37 SET FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
+38 SET EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
+39 SET HDR=RHDR
+40 IF $GET(DFN)=""
SET VAL=""
QUIT
+41 ;
+42 IF $GET(EXEC)'=""
XECUTE EXEC
SET VAL=VAL_$SELECT(VAL'="":$CHAR(10),1:"")
QUIT
+43 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+44 SET VALUE=VALUE_VAL_$SELECT(VAL'="":$CHAR(10),1:"")
+45 SET VAL=VALUE
End DoDot:4
+46 SET MVALUE=MVALUE_$$TKO^BQIUL1(VAL,$CHAR(10))
+47 ;S MVALUE=MVALUE_VAL
End DoDot:3
+48 SET VAL=MVALUE
End DoDot:2
QUIT
End DoDot:1
IF VAL'=""
QUIT
+49 ;
+50 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+51 QUIT
+52 ;
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 ;
DEF ; Default list of fields
+1 NEW CRIEN,TYP,ORD,IEN,STVW,DEFF
+2 ; Check for any alternate display order which trumps source display order
+3 SET CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")
+4 SET TYP=$PIECE(^BQI(90506.5,CRIEN,0),U,2)
+5 SET ORD=""
+6 FOR
SET ORD=$ORDER(^BQI(90506.1,"AF",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(^BQI(90506.1,"AF",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+9 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+10 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+11 SET STVW=IEN
+12 DO CVAL
+13 SET VALUE=VALUE_VAL_"^"
+14 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 SET TYP="D"
SET ORD=""
+17 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+18 SET IEN=""
+19 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+20 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+21 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+22 SET STVW=IEN
+23 DO CVAL
+24 SET VALUE=VALUE_VAL_"^"
+25 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 NEW CRIEN,TYP,ORD,IEN,STVW
+28 SET CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")
+29 SET TYP=$PIECE(^BQI(90506.5,CRIEN,0),U,2)
+30 SET ORD=""
+31 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+32 SET IEN=""
+33 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+34 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+35 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+36 SET STVW=IEN
+37 DO CVAL
+38 SET VALUE=VALUE_VAL_"^"
+39 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
End DoDot:1
+40 QUIT
+41 ;
