BQIPTFLG ;PRXM/HC/ALA-Patient Flag Indicator ; 14 Dec 2006 1:34 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
GET(DATA,PDFN) ;EP -- BQI GET FLAG IND BY DFN
;Description
; Returns all flag indicators by panel and owner for a patient
;Input
; PDFN - Patient internal entry number
;
;Assumes DUZ
;
NEW UID,II,BQIFLAG,PPDFN,BQIPREF,QFL,OWNR,PLIEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTFLG",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTFLG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D RET^BQIFLAG(DUZ,.BQIPREF)
S @DATA@(II)="I00010OWNER^I00010PANEL_IEN^T00001FLAG_INDICATOR^T00015PANEL_ID"_$C(30)
S PLIEN=""
F S PLIEN=$O(^BQICARE("AB",PDFN,DUZ,PLIEN)) Q:PLIEN="" D
. I $P(^BQICARE(DUZ,1,PLIEN,40,PDFN,0),"^",2)="R" Q
. S PPDFN=0,QFL=0
. F S PPDFN=$O(^BQICARE(DUZ,1,PLIEN,40,PPDFN)) Q:'PPDFN D Q:QFL
.. I $P(^BQICARE(DUZ,1,PLIEN,40,PPDFN,0),"^",2)="R" Q
.. S BQIFLAG=$$FPAT^BQIFLAG(PPDFN,DUZ,.BQIPREF)
.. I BQIFLAG S QFL=1
. S II=II+1,@DATA@(II)=DUZ_"^"_PLIEN_"^"_$S(QFL:"Y",1:"")_"^"_$$PLID^BQIUG1(DUZ,PLIEN)_$C(30)
;
; Check for shared panels
S OWNR=""
F S OWNR=$O(^BQICARE("C",DUZ,OWNR)) Q:OWNR="" D
. S PLIEN=""
. F S PLIEN=$O(^BQICARE("C",DUZ,OWNR,PLIEN)) Q:PLIEN="" D
.. I $G(^BQICARE(OWNR,1,PLIEN,40,PDFN,0))="" Q
.. I $P(^BQICARE(OWNR,1,PLIEN,40,PDFN,0),"^",2)="R" Q
.. S PPDFN=0,QFL=0
.. F S PPDFN=$O(^BQICARE(OWNR,1,PLIEN,40,PPDFN)) Q:'PPDFN D Q:QFL
... S BQIFLAG=$$FPAT^BQIFLAG(PPDFN,DUZ,.BQIPREF)
... I BQIFLAG S QFL=1
.. S II=II+1,@DATA@(II)=OWNR_"^"_PLIEN_"^"_$S(QFL:"Y",1:"")_"^"_$$PLID^BQIUG1(OWNR,PLIEN)_$C(30)
;
DONE 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
BQIPTFLG ;PRXM/HC/ALA-Patient Flag Indicator ; 14 Dec 2006 1:34 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
GET(DATA,PDFN) ;EP -- BQI GET FLAG IND BY DFN
+1 ;Description
+2 ; Returns all flag indicators by panel and owner for a patient
+3 ;Input
+4 ; PDFN - Patient internal entry number
+5 ;
+6 ;Assumes DUZ
+7 ;
+8 NEW UID,II,BQIFLAG,PPDFN,BQIPREF,QFL,OWNR,PLIEN
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BQIPTFLG",UID))
+11 KILL @DATA
+12 ;
+13 SET II=0
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTFLG D UNWIND^%ZTER"
+15 ;
+16 DO RET^BQIFLAG(DUZ,.BQIPREF)
+17 SET @DATA@(II)="I00010OWNER^I00010PANEL_IEN^T00001FLAG_INDICATOR^T00015PANEL_ID"_$CHAR(30)
+18 SET PLIEN=""
+19 FOR
SET PLIEN=$ORDER(^BQICARE("AB",PDFN,DUZ,PLIEN))
IF PLIEN=""
QUIT
Begin DoDot:1
+20 IF $PIECE(^BQICARE(DUZ,1,PLIEN,40,PDFN,0),"^",2)="R"
QUIT
+21 SET PPDFN=0
SET QFL=0
+22 FOR
SET PPDFN=$ORDER(^BQICARE(DUZ,1,PLIEN,40,PPDFN))
IF 'PPDFN
QUIT
Begin DoDot:2
+23 IF $PIECE(^BQICARE(DUZ,1,PLIEN,40,PPDFN,0),"^",2)="R"
QUIT
+24 SET BQIFLAG=$$FPAT^BQIFLAG(PPDFN,DUZ,.BQIPREF)
+25 IF BQIFLAG
SET QFL=1
End DoDot:2
IF QFL
QUIT
+26 SET II=II+1
SET @DATA@(II)=DUZ_"^"_PLIEN_"^"_$SELECT(QFL:"Y",1:"")_"^"_$$PLID^BQIUG1(DUZ,PLIEN)_$CHAR(30)
End DoDot:1
+27 ;
+28 ; Check for shared panels
+29 SET OWNR=""
+30 FOR
SET OWNR=$ORDER(^BQICARE("C",DUZ,OWNR))
IF OWNR=""
QUIT
Begin DoDot:1
+31 SET PLIEN=""
+32 FOR
SET PLIEN=$ORDER(^BQICARE("C",DUZ,OWNR,PLIEN))
IF PLIEN=""
QUIT
Begin DoDot:2
+33 IF $GET(^BQICARE(OWNR,1,PLIEN,40,PDFN,0))=""
QUIT
+34 IF $PIECE(^BQICARE(OWNR,1,PLIEN,40,PDFN,0),"^",2)="R"
QUIT
+35 SET PPDFN=0
SET QFL=0
+36 FOR
SET PPDFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,PPDFN))
IF 'PPDFN
QUIT
Begin DoDot:3
+37 SET BQIFLAG=$$FPAT^BQIFLAG(PPDFN,DUZ,.BQIPREF)
+38 IF BQIFLAG
SET QFL=1
End DoDot:3
IF QFL
QUIT
+39 SET II=II+1
SET @DATA@(II)=OWNR_"^"_PLIEN_"^"_$SELECT(QFL:"Y",1:"")_"^"_$$PLID^BQIUG1(OWNR,PLIEN)_$CHAR(30)
End DoDot:2
End DoDot:1
+40 ;
DONE SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
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
