- BQIPTPNL ;PRXM/HC/ALA-Get Panels for a Patient ; 09 Nov 2005 10:41 AM
- ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
- ;
- Q
- ;
- GET(DATA,DFN,OWNR) ; EP -- BQI GET PANELS BY PATIENT
- ;
- ;Description
- ; Get a list of all panels that a patient is on
- ;Input
- ; DFN - Patient internal entry number
- ; OWNR - If only valid for a specific owner
- ;
- NEW UID,BQI,PLIEN,PLNM,PLID,X,SHRS,PCAT
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),BQI=0
- S DATA=$NA(^TMP("BQIPTPNL",UID))
- K @DATA
- ;
- ;Set error trap
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTPNL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S @DATA@(BQI)="I00010PANEL_IEN^T00015PANEL_ID^T00120PANEL_NAME^T00250PANEL_DESCRIPTION^I00010OWNER^T00035OWNER_NAME^T00035PANEL_CATEGORY"_$C(30)
- I $G(OWNR)'="" D PNL G DONE
- S OWNR=""
- F S OWNR=$O(^BQICARE("AB",DFN,OWNR)) Q:OWNR="" D PNL
- DONE ;
- S BQI=BQI+1,@DATA@(BQI)=$C(31)
- Q
- ;
- PNL ; Find panels
- S PLIEN=""
- F S PLIEN=$O(^BQICARE("AB",DFN,OWNR,PLIEN)) Q:PLIEN="" D
- . I $G(^BQICARE(OWNR,1,PLIEN,40,DFN,0))="" K ^BQICARE("AB",DFN,OWNR,PLIEN) Q
- . NEW DA,IENS,PLID
- . S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
- . I $$GET1^DIQ(90505.01,IENS,.13,"I")]"" Q
- . ; Exclude panel if patient was "removed"
- . I $$GET1^DIQ(90505.04,DFN_","_IENS,.02,"I")="R" Q
- . S PLID=$$PLID^BQIUG1(OWNR,PLIEN)
- . S PCAT=$$PCAT^BQIPLDF(OWNR,PLIEN)
- . S BQI=BQI+1,@DATA@(BQI)=PLIEN_"^"_PLID_"^"_$$GET1^DIQ(90505.01,IENS,.01,"E")_"^"_$$GET1^DIQ(90505.01,IENS,1,"E")_"^"_OWNR_"^"_$$GET1^DIQ(90505,OWNR_",",.01,"E")_"^"_PCAT_$C(30)
- ;
- ; if patient is on a panel that is shared with the owner, get those panels too
- S SHRS=""
- F S SHRS=$O(^BQICARE("C",OWNR,SHRS)) Q:SHRS="" D
- . S PLIEN=""
- . F S PLIEN=$O(^BQICARE("C",OWNR,SHRS,PLIEN)) Q:PLIEN="" D
- .. NEW DA,IENS,PLID
- .. S DA(1)=SHRS,DA=PLIEN,IENS=$$IENS^DILF(.DA)
- .. I $$GET1^DIQ(90505.04,DFN_","_IENS,.01,"I")="" Q
- .. I $$GET1^DIQ(90505.04,DFN_","_IENS,.02,"I")="R" Q
- .. S PLID=$$PLID^BQIUG1(SHRS,PLIEN)
- .. S PCAT=$$PCAT^BQIPLDF(OWNR,PLIEN)
- .. S BQI=BQI+1,@DATA@(BQI)=PLIEN_"^"_PLID_"^"_$$GET1^DIQ(90505.01,IENS,.01,"E")_"^"_$$GET1^DIQ(90505.01,IENS,1,"E")_"^"_SHRS_"^"_$$GET1^DIQ(90505,SHRS_",",.01,"E")_"^"_PCAT_$C(30)
- 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(BQI),$D(DATA) S BQI=BQI+1,@DATA@(BQI)=$C(31)
- Q
- BQIPTPNL ;PRXM/HC/ALA-Get Panels for a Patient ; 09 Nov 2005 10:41 AM
- +1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
- +2 ;
- +3 QUIT
- +4 ;
- GET(DATA,DFN,OWNR) ; EP -- BQI GET PANELS BY PATIENT
- +1 ;
- +2 ;Description
- +3 ; Get a list of all panels that a patient is on
- +4 ;Input
- +5 ; DFN - Patient internal entry number
- +6 ; OWNR - If only valid for a specific owner
- +7 ;
- +8 NEW UID,BQI,PLIEN,PLNM,PLID,X,SHRS,PCAT
- +9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- SET BQI=0
- +10 SET DATA=$NAME(^TMP("BQIPTPNL",UID))
- +11 KILL @DATA
- +12 ;
- +13 ;Set error trap
- +14 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTPNL D UNWIND^%ZTER"
- +15 ;
- +16 SET @DATA@(BQI)="I00010PANEL_IEN^T00015PANEL_ID^T00120PANEL_NAME^T00250PANEL_DESCRIPTION^I00010OWNER^T00035OWNER_NAME^T00035PANEL_CATEGORY"_$CHAR(30)
- +17 IF $GET(OWNR)'=""
- DO PNL
- GOTO DONE
- +18 SET OWNR=""
- +19 FOR
- SET OWNR=$ORDER(^BQICARE("AB",DFN,OWNR))
- IF OWNR=""
- QUIT
- DO PNL
- DONE ;
- +1 SET BQI=BQI+1
- SET @DATA@(BQI)=$CHAR(31)
- +2 QUIT
- +3 ;
- PNL ; Find panels
- +1 SET PLIEN=""
- +2 FOR
- SET PLIEN=$ORDER(^BQICARE("AB",DFN,OWNR,PLIEN))
- IF PLIEN=""
- QUIT
- Begin DoDot:1
- +3 IF $GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0))=""
- KILL ^BQICARE("AB",DFN,OWNR,PLIEN)
- QUIT
- +4 NEW DA,IENS,PLID
- +5 SET DA(1)=OWNR
- SET DA=PLIEN
- SET IENS=$$IENS^DILF(.DA)
- +6 IF $$GET1^DIQ(90505.01,IENS,.13,"I")]""
- QUIT
- +7 ; Exclude panel if patient was "removed"
- +8 IF $$GET1^DIQ(90505.04,DFN_","_IENS,.02,"I")="R"
- QUIT
- +9 SET PLID=$$PLID^BQIUG1(OWNR,PLIEN)
- +10 SET PCAT=$$PCAT^BQIPLDF(OWNR,PLIEN)
- +11 SET BQI=BQI+1
- SET @DATA@(BQI)=PLIEN_"^"_PLID_"^"_$$GET1^DIQ(90505.01,IENS,.01,"E")_"^"_$$GET1^DIQ(90505.01,IENS,1,"E")_"^"_OWNR_"^"_$$GET1^DIQ(90505,OWNR_",",.01,"E")_"^"_PCAT_$CHAR(30)
- End DoDot:1
- +12 ;
- +13 ; if patient is on a panel that is shared with the owner, get those panels too
- +14 SET SHRS=""
- +15 FOR
- SET SHRS=$ORDER(^BQICARE("C",OWNR,SHRS))
- IF SHRS=""
- QUIT
- Begin DoDot:1
- +16 SET PLIEN=""
- +17 FOR
- SET PLIEN=$ORDER(^BQICARE("C",OWNR,SHRS,PLIEN))
- IF PLIEN=""
- QUIT
- Begin DoDot:2
- +18 NEW DA,IENS,PLID
- +19 SET DA(1)=SHRS
- SET DA=PLIEN
- SET IENS=$$IENS^DILF(.DA)
- +20 IF $$GET1^DIQ(90505.04,DFN_","_IENS,.01,"I")=""
- QUIT
- +21 IF $$GET1^DIQ(90505.04,DFN_","_IENS,.02,"I")="R"
- QUIT
- +22 SET PLID=$$PLID^BQIUG1(SHRS,PLIEN)
- +23 SET PCAT=$$PCAT^BQIPLDF(OWNR,PLIEN)
- +24 SET BQI=BQI+1
- SET @DATA@(BQI)=PLIEN_"^"_PLID_"^"_$$GET1^DIQ(90505.01,IENS,.01,"E")_"^"_$$GET1^DIQ(90505.01,IENS,1,"E")_"^"_SHRS_"^"_$$GET1^DIQ(90505,SHRS_",",.01,"E")_"^"_PCAT_$CHAR(30)
- End DoDot:2
- End DoDot:1
- +25 QUIT
- +26 ;
- 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(BQI)
- IF $DATA(DATA)
- SET BQI=BQI+1
- SET @DATA@(BQI)=$CHAR(31)
- +6 QUIT
