BQIPLPNL.m

BQIPLPNL ;GDIT/HS/ALA-Get list of Panels used as Filters ; 28 Dec 2006  11:22 AM

 ;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43

 ;

 Q

 ;

EN(DATA,OWNR,PLIEN) ;EP -- BQI GET FILTER PANELS

 ;Description

 ;  Get the user's panels containing panel filters

 ;Input

 ;  PLIEN - If checking a specific panel

 ;Output

 ;  DATA  - name of global (passed by reference) in which the data

 ;          is stored

 ;Expects

 ;  DUZ - the internal entry number of the person signed on

 ;

 NEW UID,II,VALUE,PLNME,POWNR,PPLIEN

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLPNL",UID))

 K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLPNL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S @DATA@(II)="I00010OWNER^I00010PANEL_IEN^I00010PANEL_ID^T00120PANEL_NAME"_$C(30)

 ;

 S PLIEN=$G(PLIEN,"") I PLIEN="" G DONE

 S OWNR=$G(OWNR,DUZ)

 S PLNME=$P(^BQICARE(OWNR,1,PLIEN,0),U,1)

 S VALUE=OWNR_$C(26)_PLNME

 ;

 S POWNR=""

 F  S POWNR=$O(^BQICARE("AD",VALUE,POWNR)) Q:POWNR=""  D

 . S PPLIEN=""

 . F  S PPLIEN=$O(^BQICARE("AD",VALUE,POWNR,PPLIEN)) Q:PPLIEN=""  D

 .. I $G(^BQICARE(POWNR,1,PPLIEN,0))="" K ^BQICARE("AD",VALUE,POWNR,PPLIEN) Q

 .. S II=II+1,@DATA@(II)=POWNR_"^"_PPLIEN_"^"_$$PLID^BQIUG1(POWNR,PPLIEN)_"^"_$P(^BQICARE(POWNR,1,PPLIEN,0),U,1)_$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

BQIPLPNL  ;GDIT/HS/ALA-Get list of Panels used as Filters ; 28 Dec 2006  11:22 AM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43

 +2       ;

 +3        QUIT 

 +4       ;

EN(DATA,OWNR,PLIEN) ;EP -- BQI GET FILTER PANELS

 +1       ;Description

 +2       ;  Get the user's panels containing panel filters

 +3       ;Input

 +4       ;  PLIEN - If checking a specific panel

 +5       ;Output

 +6       ;  DATA  - name of global (passed by reference) in which the data

 +7       ;          is stored

 +8       ;Expects

 +9       ;  DUZ - the internal entry number of the person signed on

 +10      ;

 +11       NEW UID,II,VALUE,PLNME,POWNR,PPLIEN

 +12       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +13       SET DATA=$NAME(^TMP("BQIPLPNL",UID))

 +14       KILL @DATA

 +15      ;

 +16       SET II=0

 +17      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLPNL D UNWIND^%ZTER"

 +18      ;

 +19       SET @DATA@(II)="I00010OWNER^I00010PANEL_IEN^I00010PANEL_ID^T00120PANEL_NAME"_$CHAR(30)

 +20      ;

 +21       SET PLIEN=$GET(PLIEN,"")

           IF PLIEN=""

               GOTO DONE

 +22       SET OWNR=$GET(OWNR,DUZ)

 +23       SET PLNME=$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)

 +24       SET VALUE=OWNR_$CHAR(26)_PLNME

 +25      ;

 +26       SET POWNR=""

 +27       FOR 

               SET POWNR=$ORDER(^BQICARE("AD",VALUE,POWNR))

               IF POWNR=""

                   QUIT 

               Begin DoDot:1

 +28               SET PPLIEN=""

 +29               FOR 

                       SET PPLIEN=$ORDER(^BQICARE("AD",VALUE,POWNR,PPLIEN))

                       IF PPLIEN=""

                           QUIT 

                       Begin DoDot:2

 +30                       IF $GET(^BQICARE(POWNR,1,PPLIEN,0))=""

                               KILL ^BQICARE("AD",VALUE,POWNR,PPLIEN)

                               QUIT 

 +31                       SET II=II+1

                           SET @DATA@(II)=POWNR_"^"_PPLIEN_"^"_$$PLID^BQIUG1(POWNR,PPLIEN)_"^"_$PIECE(^BQICARE(POWNR,1,PPLIEN,0),U,1)_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +32      ;

DONE      ;

 +1        SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +2        QUIT 

 +3       ;

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