BQIPLSL.m

BQIPLSL ;PRXM/HC/DLS - Panel Share List ; 22 Nov 2005  9:18 AM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

 Q

 ;

EN(DATA,PLOWN,PLIEN) ; EP -- BQI GET SHARE LIST BY PANEL

 ;

 ;Description

 ;  Given a panel owner and a panel IEN, generates a list of users sharing a panel.

 ;

 ;Input

 ;  PLOWN - Panel Owner IEN

 ;  PLIEN - IEN of the panel within the Owner's file.

 ;

 ;Output

 ;  DATA - Name of global in which data is stored(^TMP("BQIPLSL"))

 ;

 N UID,X,BQII,DA,IENS

 N SHDUZ,NAME,ACC,STRT,END,SHARE

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

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

 K @DATA

 ;

 S BQII=0

 ;

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

 ;

 D HDR

 ; If no PLIEN is supplied just pass header

 I $G(PLIEN)="" G DONE

 ;

 S SHDUZ=0,DA(2)=PLOWN,DA(1)=PLIEN

 F  S SHDUZ=$O(^BQICARE(PLOWN,1,PLIEN,30,SHDUZ)) Q:'SHDUZ  D

 . S DA=SHDUZ,IENS=$$IENS^DILF(.DA)

 . S NAME=$$GET1^DIQ(200,SHDUZ_",",.01,"E")

 . S ACC=$$GET1^DIQ(90505.03,IENS,.02,"I")

 . S STRT=$$GET1^DIQ(90505.03,IENS,.03,"I") I STRT S STRT=$$FMTE^BQIUL1(STRT)

 . S END=$$GET1^DIQ(90505.03,IENS,.04,"I") I END S END=$$FMTE^BQIUL1(END)

 . S SHARE=$$GET1^DIQ(90505.03,IENS,.05,"I") S SHARE=$S(SHARE=1:"Y",1:"N")

 . S BQII=BQII+1

 . ;

 . S @DATA@(BQII)=SHDUZ_"^"_NAME_"^"_ACC_"^"_STRT_"^"_END_"^"_SHARE_$C(30)

 ;

 ; Drop down to DONE...

 ;

DONE ; -- exit code

 S BQII=BQII+1,@DATA@(BQII)=$C(31)

 Q

 ;

HDR ; -- header code

 S @DATA@(BQII)="I00004SHARE_DUZ^T00050SHARE_USER_NAME^T00002SHARE_ACCESS^D00015SHARE_START_DT^D00015SHARE_END_DT^T00003SHARE_LAYOUTS"_$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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)

 Q

BQIPLSL   ;PRXM/HC/DLS - Panel Share List ; 22 Nov 2005  9:18 AM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

 +3        QUIT 

 +4       ;

EN(DATA,PLOWN,PLIEN) ; EP -- BQI GET SHARE LIST BY PANEL

 +1       ;

 +2       ;Description

 +3       ;  Given a panel owner and a panel IEN, generates a list of users sharing a panel.

 +4       ;

 +5       ;Input

 +6       ;  PLOWN - Panel Owner IEN

 +7       ;  PLIEN - IEN of the panel within the Owner's file.

 +8       ;

 +9       ;Output

 +10      ;  DATA - Name of global in which data is stored(^TMP("BQIPLSL"))

 +11      ;

 +12       NEW UID,X,BQII,DA,IENS

 +13       NEW SHDUZ,NAME,ACC,STRT,END,SHARE

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

 +15       SET DATA=$NAME(^TMP("BQIPLSL",UID))

 +16       KILL @DATA

 +17      ;

 +18       SET BQII=0

 +19      ;

 +20      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +21      ;

 +22       DO HDR

 +23      ; If no PLIEN is supplied just pass header

 +24       IF $GET(PLIEN)=""

               GOTO DONE

 +25      ;

 +26       SET SHDUZ=0

           SET DA(2)=PLOWN

           SET DA(1)=PLIEN

 +27       FOR 

               SET SHDUZ=$ORDER(^BQICARE(PLOWN,1,PLIEN,30,SHDUZ))

               IF 'SHDUZ

                   QUIT 

               Begin DoDot:1

 +28               SET DA=SHDUZ

                   SET IENS=$$IENS^DILF(.DA)

 +29               SET NAME=$$GET1^DIQ(200,SHDUZ_",",.01,"E")

 +30               SET ACC=$$GET1^DIQ(90505.03,IENS,.02,"I")

 +31               SET STRT=$$GET1^DIQ(90505.03,IENS,.03,"I")

                   IF STRT

                       SET STRT=$$FMTE^BQIUL1(STRT)

 +32               SET END=$$GET1^DIQ(90505.03,IENS,.04,"I")

                   IF END

                       SET END=$$FMTE^BQIUL1(END)

 +33               SET SHARE=$$GET1^DIQ(90505.03,IENS,.05,"I")

                   SET SHARE=$SELECT(SHARE=1:"Y",1:"N")

 +34               SET BQII=BQII+1

 +35      ;

 +36               SET @DATA@(BQII)=SHDUZ_"^"_NAME_"^"_ACC_"^"_STRT_"^"_END_"^"_SHARE_$CHAR(30)

               End DoDot:1

 +37      ;

 +38      ; Drop down to DONE...

 +39      ;

DONE      ; -- exit code

 +1        SET BQII=BQII+1

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

 +2        QUIT 

 +3       ;

HDR       ; -- header code

 +1        SET @DATA@(BQII)="I00004SHARE_DUZ^T00050SHARE_USER_NAME^T00002SHARE_ACCESS^D00015SHARE_START_DT^D00015SHARE_END_DT^T00003SHARE_LAYOUTS"_$CHAR(30)

 +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(BQII)

               IF $DATA(DATA)

                   SET BQII=BQII+1

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

 +6        QUIT