BQIPTPNL.m

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