BQIFLGET ;GDIT/HS/ALA-Get flags ; 14 Dec 2005 11:22 AM
;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
;
Q
;
RET(DATA,DTYP,OWNR,PLIEN,DFN) ; EP -- BQI GET FLAGS
;
;Description
;
;Input
; DTYP = Display Type; 'A'=All flags, 'S'=Shown flags,
; 'H'=Hidden flags
; OWNR = User identifier if DUZ is a shared person
; PLIEN = Panel IEN
; DFN = Patient identifier
;
NEW UID,II,DOB,SENS,PTSEX,PTAGE,HRN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIFLGET",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIFLGET D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010FLAG_DEF_IEN^I00010FLAG_IEN^I00010DFN^T00030PATIENT_NAME^T00030HRN^T00050DPCP^T00030FLAG_TYPE^D00015FLAG_DATE^T00010FLAG_ACTION^T00001FLAG_STATUS^T00250FLAG_DESC^D00030DOB^T00001SENS_FLAG^T00001SEX^T00007AGE"_$C(30)
S DFN=$G(DFN,"")
S OWNR=$G(OWNR,"")
;
I $G(DFN)'="" D PAT G DONE
I $G(OWNR)'="" D PNL G DONE
D ALL
;
DONE ; Finish the RPC call
S II=II+1,@DATA@(II)=$C(31)
K PARMS,MPARMS,ADTM,ADATM,ADESC,ADIEN,ALIEN,X,Y,TMFRAME,NM,REFLOW
K STAT,DA,IENS,AACT,FDT,TDT,SOURCE,VALUE,NAME,PIEN,PMIEN,PTYP,SPNLNM
K HRN,AIEN,FSTAT,FDTM,RIEN,%DT,PNAME,VIEN,PARMS,MPARMS,ORPHY,TST,UNIT
K RANGE,RSLT,TEST,AFLG,BQIPREF,PLIEN,NRMABN,PAR,PNL,PNLNM,REFHIGH,VISIT
Q
;
ALL ; For all patients defined in the patient lists for the user.
;
;Parameters
; DFN = Patient internal entry number
; ADIEN = Flag definition internal entry number
; ADESC = Flag definition description
; TMFRAME = Relative date defined by user
; ALIEN = Flag record internal entry number
; ADTM,FDT = Time Frame starting date
; ADATM = Flag date
; STAT = Status of the flag for this user
; AACT = Flag Action (S=Show, H=Hide)
; DOB = Patient's Date of Birth
; SENS = Sensitive Patient Flag
; PTSEX = Patient's gender
; PTAGE = Patient's current age
;
D RET^BQIFLAG(DUZ,.BQIPREF)
S ADIEN=0
F S ADIEN=$O(BQIPREF(ADIEN)) Q:'ADIEN D
. ; If the flag entry is inactive, quit
. I $P(^BQI(90506,ADIEN,0),U,2)=1 Q
. S ADESC=$P(^BQI(90506,ADIEN,0),U,1)
. S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
. S FDTM=FDT
. F S FDTM=$O(^BQIPAT("AE",ADIEN,FDTM)) Q:FDTM=""!(FDTM\1>TDT) D
.. S DFN=""
.. F S DFN=$O(^BQIPAT("AE",ADIEN,FDTM,DFN)) Q:DFN="" D
... I $D(^BQICARE(DUZ,1,"AB",DFN)) D Q:'AFLG
.... ;
.... ; Check if patient is active on any panel (AFLG=1)
.... ;
.... S PLIEN="",AFLG=0
.... F S PLIEN=$O(^BQICARE(DUZ,1,"AB",DFN,PLIEN)) Q:PLIEN="" D Q:AFLG
..... I $G(^BQICARE(DUZ,1,PLIEN,40,DFN,0))="" K ^BQICARE(DUZ,1,"AB",DFN,PLIEN) Q
..... I $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)'="R" S AFLG=1
... ;
... ; If patient isn't on one of user's panels but is on a shared panel
... I '$D(^BQICARE(DUZ,1,"AB",DFN)),'$$SHR(DUZ,DFN) Q
... S ALIEN=0
... F S ALIEN=$O(^BQIPAT("AE",ADIEN,FDTM,DFN,ALIEN)) Q:ALIEN="" D
.... S PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
.... NEW FDESC
.... Q:'$D(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
.... S STAT=+$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
.... ; if the status is '1' Don't Show and the display type is 'S' don't select
.... I STAT=1,DTYP="S" Q
.... I 'STAT,DTYP="H" Q
.... ; If the status is 1, set action to "reactivate" and flag status to "hide"
.... ; If the status is not 1, set action to "deactivate" and flag status to "show"
.... S AACT=$S(STAT=1:"S",1:"H"),FSTAT=$S(STAT=1:"H",1:"S")
.... ; Get the record ien associated with the flag
.... S RIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
.... S ADATM=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
.... S VIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
.... S ADATM=$$FMTE^BQIUL1(ADATM\1)
.... I ADESC["LAB" D
..... D LAB^BQIRLB(RIEN)
..... S FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
.... I ADESC'["LAB" D
..... I VIEN="" Q
..... NEW NARR
..... S FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
..... S NARR=$$VVNAR^BQIUL1(VIEN)
..... I NARR="" S NARR=$$VPNAR^BQIUL1(VIEN)
..... S FDESC=FDESC_$C(13)_$C(10)_"POVs: "_NARR
.... S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
.... S PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
.... S PTAGE=$$AGE^BQIAGE(DFN,,1)
.... S SENS=$$SENS^BQIULPT(DFN)
.... S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
.... S II=II+1
.... S @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$P($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$G(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$C(30)
Q
;
PAT ; Get flags for one patient
;
;Parameters
; PNAME = Patient's name
;
S PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
D RET^BQIFLAG(DUZ,.BQIPREF)
I '$$FPAT^BQIFLAG(DFN,DUZ,.BQIPREF,DTYP) Q
S ADIEN=0
F S ADIEN=$O(BQIPREF(ADIEN)) Q:'ADIEN D
. ; If the flag entry is inactive, quit
. I $P(^BQI(90506,ADIEN,0),"^",2)=1 Q
. S ADESC=$P(^BQI(90506,ADIEN,0),U,1)
. S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
. S FDTM=FDT
. F S FDTM=$O(^BQIPAT("AF",DFN,ADIEN,FDTM)) Q:FDTM=""!(FDTM\1>TDT) D
.. S ALIEN=0
.. F S ALIEN=$O(^BQIPAT("AF",DFN,ADIEN,FDTM,ALIEN)) Q:'ALIEN D
... NEW FDESC
... Q:'$D(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
... S STAT=+$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
... ; if the status is '1' Don't Show and the display type is 'S' don't select
... I STAT=1,DTYP="S" Q
... I 'STAT,DTYP="H" Q
... ; If the status is 1, set action to "reactivate" and flag status to "hide"
... ; If the status is not 1, set action to "deactivate" and flag status to "show"
... S AACT=$S(STAT=1:"S",1:"H"),FSTAT=$S(STAT=1:"H",1:"S")
... ; Get the record ien associated with the flag
... S RIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
... S ADATM=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
... S VIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
... S ADATM=$$FMTE^BQIUL1(ADATM\1)
... I ADESC["LAB" D
.... D LAB^BQIRLB(RIEN)
.... S FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
... I ADESC'["LAB" D
.... I VIEN="" Q
.... NEW NARR
.... S FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
.... S NARR=$$VVNAR^BQIUL1(VIEN)
.... I NARR="" S NARR=$$VPNAR^BQIUL1(VIEN)
.... S FDESC=FDESC_$C(13)_$C(10)_"POVs: "_NARR
... S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
... S PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
... S PTAGE=$$AGE^BQIAGE(DFN,,1)
... S SENS=$$SENS^BQIULPT(DFN)
... S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
... S II=II+1
... S @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$P($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$G(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$C(30)
Q
;
PNL ; Get all flags for patients in a panel
S DFN=0
F S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN D
. I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R" Q
. Q:$O(^BQIPAT(DFN,10,0))=""
. S PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
. D RET^BQIFLAG(OWNR,.BQIPREF)
. Q:'$$FPAT^BQIFLAG(DFN,OWNR,.BQIPREF,DTYP)
. S ADIEN=0
. F S ADIEN=$O(BQIPREF(ADIEN)) Q:'ADIEN D
.. ; If the flag entry is inactive, quit
.. I $P(^BQI(90506,ADIEN,0),"^",2)=1 Q
.. S ADESC=$P(^BQI(90506,ADIEN,0),U,1)
.. S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
.. S FDTM=FDT
.. F S FDTM=$O(^BQIPAT("AF",DFN,ADIEN,FDTM)) Q:FDTM=""!(FDTM\1>TDT) D
... S ALIEN=0
... F S ALIEN=$O(^BQIPAT("AF",DFN,ADIEN,FDTM,ALIEN)) Q:'ALIEN D
.... Q:'$D(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
.... S STAT=+$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
.... ; if the status is '1' Don't Show and the display type is 'S' don't select
.... I STAT=1,DTYP="S" Q
.... I 'STAT,DTYP="H" Q
.... ; If the status is 1, set action to "reactivate" and flag status to "hide"
.... ; If the status is not 1, set action to "deactivate" and flag status to "show"
.... S AACT=$S(STAT=1:"S",1:"H"),FSTAT=$S(STAT=1:"H",1:"S")
.... ; Get the record ien associated with the flag
.... S RIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
.... S ADATM=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
.... S VIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
.... S ADATM=$$FMTE^BQIUL1(ADATM\1)
.... I ADESC["LAB" D
..... D LAB^BQIRLB(RIEN)
..... S FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
.... I ADESC'["LAB" D
..... I VIEN="" Q
..... NEW NARR
..... S FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
..... S NARR=$$VVNAR^BQIUL1(VIEN)
..... I NARR="" S NARR=$$VPNAR^BQIUL1(VIEN)
..... S FDESC=FDESC_$C(13)_$C(10)_"POVs: "_NARR
.... S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
.... S PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
.... S PTAGE=$$AGE^BQIAGE(DFN,,1)
.... S SENS=$$SENS^BQIULPT(DFN)
.... S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
.... S II=II+1
.... S @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$P($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$G(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$C(30)
Q
;
SHR(SHRU,SDFN) ;EP - Is patient in a shared panel?
N USR,SFLG,SPLIEN,SHAXCS,SHSTDT,SHENDT
S USR="",SFLG=0
F S USR=$O(^BQICARE("C",SHRU,USR)) Q:USR="" D Q:SFLG
. S SPLIEN=""
. F S SPLIEN=$O(^BQICARE("C",SHRU,USR,SPLIEN)) Q:SPLIEN="" D Q:SFLG
.. I '$D(^BQICARE(USR,1,SPLIEN,40,"B",SDFN)) Q
.. I $P(^BQICARE(USR,1,SPLIEN,40,SDFN,0),U,2)="R" Q
.. S SHAXCS=$P(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,2)
.. S SHSTDT=$P(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,3)
.. S SHENDT=$P(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,4)
.. I SHSTDT'>DT,((SHENDT'<DT)!(SHENDT="")),SHAXCS'="I" S SFLG=1
Q SFLG
;
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
BQIFLGET ;GDIT/HS/ALA-Get flags ; 14 Dec 2005 11:22 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
+2 ;
+3 QUIT
+4 ;
RET(DATA,DTYP,OWNR,PLIEN,DFN) ; EP -- BQI GET FLAGS
+1 ;
+2 ;Description
+3 ;
+4 ;Input
+5 ; DTYP = Display Type; 'A'=All flags, 'S'=Shown flags,
+6 ; 'H'=Hidden flags
+7 ; OWNR = User identifier if DUZ is a shared person
+8 ; PLIEN = Panel IEN
+9 ; DFN = Patient identifier
+10 ;
+11 NEW UID,II,DOB,SENS,PTSEX,PTAGE,HRN
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("BQIFLGET",UID))
+14 KILL @DATA
+15 ;
+16 SET II=0
+17 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIFLGET D UNWIND^%ZTER"
+18 ;
+19 SET @DATA@(II)="I00010FLAG_DEF_IEN^I00010FLAG_IEN^I00010DFN^T00030PATIENT_NAME^T00030HRN^T00050DPCP^T00030FLAG_TYPE^D00015FLAG_DATE^T00010FLAG_ACTION^T00001FLAG_STATUS^T00250FLAG_DESC^D00030DOB^T00001SENS_FLAG^T00001SEX^T00007AGE"_$CHAR(30)
+20 SET DFN=$GET(DFN,"")
+21 SET OWNR=$GET(OWNR,"")
+22 ;
+23 IF $GET(DFN)'=""
DO PAT
GOTO DONE
+24 IF $GET(OWNR)'=""
DO PNL
GOTO DONE
+25 DO ALL
+26 ;
DONE ; Finish the RPC call
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 KILL PARMS,MPARMS,ADTM,ADATM,ADESC,ADIEN,ALIEN,X,Y,TMFRAME,NM,REFLOW
+3 KILL STAT,DA,IENS,AACT,FDT,TDT,SOURCE,VALUE,NAME,PIEN,PMIEN,PTYP,SPNLNM
+4 KILL HRN,AIEN,FSTAT,FDTM,RIEN,%DT,PNAME,VIEN,PARMS,MPARMS,ORPHY,TST,UNIT
+5 KILL RANGE,RSLT,TEST,AFLG,BQIPREF,PLIEN,NRMABN,PAR,PNL,PNLNM,REFHIGH,VISIT
+6 QUIT
+7 ;
ALL ; For all patients defined in the patient lists for the user.
+1 ;
+2 ;Parameters
+3 ; DFN = Patient internal entry number
+4 ; ADIEN = Flag definition internal entry number
+5 ; ADESC = Flag definition description
+6 ; TMFRAME = Relative date defined by user
+7 ; ALIEN = Flag record internal entry number
+8 ; ADTM,FDT = Time Frame starting date
+9 ; ADATM = Flag date
+10 ; STAT = Status of the flag for this user
+11 ; AACT = Flag Action (S=Show, H=Hide)
+12 ; DOB = Patient's Date of Birth
+13 ; SENS = Sensitive Patient Flag
+14 ; PTSEX = Patient's gender
+15 ; PTAGE = Patient's current age
+16 ;
+17 DO RET^BQIFLAG(DUZ,.BQIPREF)
+18 SET ADIEN=0
+19 FOR
SET ADIEN=$ORDER(BQIPREF(ADIEN))
IF 'ADIEN
QUIT
Begin DoDot:1
+20 ; If the flag entry is inactive, quit
+21 IF $PIECE(^BQI(90506,ADIEN,0),U,2)=1
QUIT
+22 SET ADESC=$PIECE(^BQI(90506,ADIEN,0),U,1)
+23 SET FDT=$PIECE(BQIPREF(ADIEN),U,1)
SET TDT=$PIECE(BQIPREF(ADIEN),U,2)
+24 SET FDTM=FDT
+25 FOR
SET FDTM=$ORDER(^BQIPAT("AE",ADIEN,FDTM))
IF FDTM=""!(FDTM\1>TDT)
QUIT
Begin DoDot:2
+26 SET DFN=""
+27 FOR
SET DFN=$ORDER(^BQIPAT("AE",ADIEN,FDTM,DFN))
IF DFN=""
QUIT
Begin DoDot:3
+28 IF $DATA(^BQICARE(DUZ,1,"AB",DFN))
Begin DoDot:4
+29 ;
+30 ; Check if patient is active on any panel (AFLG=1)
+31 ;
+32 SET PLIEN=""
SET AFLG=0
+33 FOR
SET PLIEN=$ORDER(^BQICARE(DUZ,1,"AB",DFN,PLIEN))
IF PLIEN=""
QUIT
Begin DoDot:5
+34 IF $GET(^BQICARE(DUZ,1,PLIEN,40,DFN,0))=""
KILL ^BQICARE(DUZ,1,"AB",DFN,PLIEN)
QUIT
+35 IF $PIECE(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)'="R"
SET AFLG=1
End DoDot:5
IF AFLG
QUIT
End DoDot:4
IF 'AFLG
QUIT
+36 ;
+37 ; If patient isn't on one of user's panels but is on a shared panel
+38 IF '$DATA(^BQICARE(DUZ,1,"AB",DFN))
IF '$$SHR(DUZ,DFN)
QUIT
+39 SET ALIEN=0
+40 FOR
SET ALIEN=$ORDER(^BQIPAT("AE",ADIEN,FDTM,DFN,ALIEN))
IF ALIEN=""
QUIT
Begin DoDot:4
+41 SET PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
+42 NEW FDESC
+43 IF '$DATA(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
QUIT
+44 SET STAT=+$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
+45 ; if the status is '1' Don't Show and the display type is 'S' don't select
+46 IF STAT=1
IF DTYP="S"
QUIT
+47 IF 'STAT
IF DTYP="H"
QUIT
+48 ; If the status is 1, set action to "reactivate" and flag status to "hide"
+49 ; If the status is not 1, set action to "deactivate" and flag status to "show"
+50 SET AACT=$SELECT(STAT=1:"S",1:"H")
SET FSTAT=$SELECT(STAT=1:"H",1:"S")
+51 ; Get the record ien associated with the flag
+52 SET RIEN=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
+53 SET ADATM=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
+54 SET VIEN=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
+55 SET ADATM=$$FMTE^BQIUL1(ADATM\1)
+56 IF ADESC["LAB"
Begin DoDot:5
+57 DO LAB^BQIRLB(RIEN)
+58 SET FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
End DoDot:5
+59 IF ADESC'["LAB"
Begin DoDot:5
+60 IF VIEN=""
QUIT
+61 NEW NARR
+62 SET FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
+63 SET NARR=$$VVNAR^BQIUL1(VIEN)
+64 IF NARR=""
SET NARR=$$VPNAR^BQIUL1(VIEN)
+65 SET FDESC=FDESC_$CHAR(13)_$CHAR(10)_"POVs: "_NARR
End DoDot:5
+66 SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+67 SET PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
+68 SET PTAGE=$$AGE^BQIAGE(DFN,,1)
+69 SET SENS=$$SENS^BQIULPT(DFN)
+70 SET HRN=$$HRNL^BQIULPT(DFN)
SET HRN=$TRANSLATE(HRN,";",$CHAR(10))
+71 SET II=II+1
+72 SET @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$PIECE($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$GET(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$CHAR(30)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+73 QUIT
+74 ;
PAT ; Get flags for one patient
+1 ;
+2 ;Parameters
+3 ; PNAME = Patient's name
+4 ;
+5 SET PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
+6 DO RET^BQIFLAG(DUZ,.BQIPREF)
+7 IF '$$FPAT^BQIFLAG(DFN,DUZ,.BQIPREF,DTYP)
QUIT
+8 SET ADIEN=0
+9 FOR
SET ADIEN=$ORDER(BQIPREF(ADIEN))
IF 'ADIEN
QUIT
Begin DoDot:1
+10 ; If the flag entry is inactive, quit
+11 IF $PIECE(^BQI(90506,ADIEN,0),"^",2)=1
QUIT
+12 SET ADESC=$PIECE(^BQI(90506,ADIEN,0),U,1)
+13 SET FDT=$PIECE(BQIPREF(ADIEN),U,1)
SET TDT=$PIECE(BQIPREF(ADIEN),U,2)
+14 SET FDTM=FDT
+15 FOR
SET FDTM=$ORDER(^BQIPAT("AF",DFN,ADIEN,FDTM))
IF FDTM=""!(FDTM\1>TDT)
QUIT
Begin DoDot:2
+16 SET ALIEN=0
+17 FOR
SET ALIEN=$ORDER(^BQIPAT("AF",DFN,ADIEN,FDTM,ALIEN))
IF 'ALIEN
QUIT
Begin DoDot:3
+18 NEW FDESC
+19 IF '$DATA(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
QUIT
+20 SET STAT=+$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
+21 ; if the status is '1' Don't Show and the display type is 'S' don't select
+22 IF STAT=1
IF DTYP="S"
QUIT
+23 IF 'STAT
IF DTYP="H"
QUIT
+24 ; If the status is 1, set action to "reactivate" and flag status to "hide"
+25 ; If the status is not 1, set action to "deactivate" and flag status to "show"
+26 SET AACT=$SELECT(STAT=1:"S",1:"H")
SET FSTAT=$SELECT(STAT=1:"H",1:"S")
+27 ; Get the record ien associated with the flag
+28 SET RIEN=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
+29 SET ADATM=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
+30 SET VIEN=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
+31 SET ADATM=$$FMTE^BQIUL1(ADATM\1)
+32 IF ADESC["LAB"
Begin DoDot:4
+33 DO LAB^BQIRLB(RIEN)
+34 SET FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
End DoDot:4
+35 IF ADESC'["LAB"
Begin DoDot:4
+36 IF VIEN=""
QUIT
+37 NEW NARR
+38 SET FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
+39 SET NARR=$$VVNAR^BQIUL1(VIEN)
+40 IF NARR=""
SET NARR=$$VPNAR^BQIUL1(VIEN)
+41 SET FDESC=FDESC_$CHAR(13)_$CHAR(10)_"POVs: "_NARR
End DoDot:4
+42 SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+43 SET PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
+44 SET PTAGE=$$AGE^BQIAGE(DFN,,1)
+45 SET SENS=$$SENS^BQIULPT(DFN)
+46 SET HRN=$$HRNL^BQIULPT(DFN)
SET HRN=$TRANSLATE(HRN,";",$CHAR(10))
+47 SET II=II+1
+48 SET @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$PIECE($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$GET(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+49 QUIT
+50 ;
PNL ; Get all flags for patients in a panel
+1 SET DFN=0
+2 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+3 IF $PIECE(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R"
QUIT
+4 IF $ORDER(^BQIPAT(DFN,10,0))=""
QUIT
+5 SET PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
+6 DO RET^BQIFLAG(OWNR,.BQIPREF)
+7 IF '$$FPAT^BQIFLAG(DFN,OWNR,.BQIPREF,DTYP)
QUIT
+8 SET ADIEN=0
+9 FOR
SET ADIEN=$ORDER(BQIPREF(ADIEN))
IF 'ADIEN
QUIT
Begin DoDot:2
+10 ; If the flag entry is inactive, quit
+11 IF $PIECE(^BQI(90506,ADIEN,0),"^",2)=1
QUIT
+12 SET ADESC=$PIECE(^BQI(90506,ADIEN,0),U,1)
+13 SET FDT=$PIECE(BQIPREF(ADIEN),U,1)
SET TDT=$PIECE(BQIPREF(ADIEN),U,2)
+14 SET FDTM=FDT
+15 FOR
SET FDTM=$ORDER(^BQIPAT("AF",DFN,ADIEN,FDTM))
IF FDTM=""!(FDTM\1>TDT)
QUIT
Begin DoDot:3
+16 SET ALIEN=0
+17 FOR
SET ALIEN=$ORDER(^BQIPAT("AF",DFN,ADIEN,FDTM,ALIEN))
IF 'ALIEN
QUIT
Begin DoDot:4
+18 IF '$DATA(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
QUIT
+19 SET STAT=+$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
+20 ; if the status is '1' Don't Show and the display type is 'S' don't select
+21 IF STAT=1
IF DTYP="S"
QUIT
+22 IF 'STAT
IF DTYP="H"
QUIT
+23 ; If the status is 1, set action to "reactivate" and flag status to "hide"
+24 ; If the status is not 1, set action to "deactivate" and flag status to "show"
+25 SET AACT=$SELECT(STAT=1:"S",1:"H")
SET FSTAT=$SELECT(STAT=1:"H",1:"S")
+26 ; Get the record ien associated with the flag
+27 SET RIEN=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
+28 SET ADATM=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
+29 SET VIEN=$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
+30 SET ADATM=$$FMTE^BQIUL1(ADATM\1)
+31 IF ADESC["LAB"
Begin DoDot:5
+32 DO LAB^BQIRLB(RIEN)
+33 SET FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
End DoDot:5
+34 IF ADESC'["LAB"
Begin DoDot:5
+35 IF VIEN=""
QUIT
+36 NEW NARR
+37 SET FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
+38 SET NARR=$$VVNAR^BQIUL1(VIEN)
+39 IF NARR=""
SET NARR=$$VPNAR^BQIUL1(VIEN)
+40 SET FDESC=FDESC_$CHAR(13)_$CHAR(10)_"POVs: "_NARR
End DoDot:5
+41 SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+42 SET PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
+43 SET PTAGE=$$AGE^BQIAGE(DFN,,1)
+44 SET SENS=$$SENS^BQIULPT(DFN)
+45 SET HRN=$$HRNL^BQIULPT(DFN)
SET HRN=$TRANSLATE(HRN,";",$CHAR(10))
+46 SET II=II+1
+47 SET @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$PIECE($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$GET(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$CHAR(30)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
SHR(SHRU,SDFN) ;EP - Is patient in a shared panel?
+1 NEW USR,SFLG,SPLIEN,SHAXCS,SHSTDT,SHENDT
+2 SET USR=""
SET SFLG=0
+3 FOR
SET USR=$ORDER(^BQICARE("C",SHRU,USR))
IF USR=""
QUIT
Begin DoDot:1
+4 SET SPLIEN=""
+5 FOR
SET SPLIEN=$ORDER(^BQICARE("C",SHRU,USR,SPLIEN))
IF SPLIEN=""
QUIT
Begin DoDot:2
+6 IF '$DATA(^BQICARE(USR,1,SPLIEN,40,"B",SDFN))
QUIT
+7 IF $PIECE(^BQICARE(USR,1,SPLIEN,40,SDFN,0),U,2)="R"
QUIT
+8 SET SHAXCS=$PIECE(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,2)
+9 SET SHSTDT=$PIECE(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,3)
+10 SET SHENDT=$PIECE(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,4)
+11 IF SHSTDT'>DT
IF ((SHENDT'<DT)!(SHENDT=""))
IF SHAXCS'="I"
SET SFLG=1
End DoDot:2
IF SFLG
QUIT
End DoDot:1
IF SFLG
QUIT
+12 QUIT SFLG
+13 ;
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
