- 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
