BQIPLDFN.m

BQIPLDFN ;PRXM/HC/DB-Get list of DFNs for a Panel ; 1 Mar 2007  5:13 PM

 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 ;

 Q

 ;

RET(DATA,OWNR,PLIEN) ; PEP -- BQI GET DFN LIST BY PANEL

 ;

 ;Description

 ;

 ;Input

 ;  OWNR  = User identifier if DUZ is a shared person

 ;  PLIEN = Panel IEN

 ;

 NEW UID,II,DFN

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

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

 K @DATA

 ;

 S II=0

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

 ;

 S @DATA@(II)="I00010DFN"_$C(30)

 S DFN=0

 F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D

 . I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q

 . S II=II+1,@DATA@(II)=DFN_$C(30)

 ;

DONE ; Finish the RPC call

 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

BQIPLDFN  ;PRXM/HC/DB-Get list of DFNs for a Panel ; 1 Mar 2007  5:13 PM

 +1       ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 +2       ;

 +3        QUIT 

 +4       ;

RET(DATA,OWNR,PLIEN) ; PEP -- BQI GET DFN LIST BY PANEL

 +1       ;

 +2       ;Description

 +3       ;

 +4       ;Input

 +5       ;  OWNR  = User identifier if DUZ is a shared person

 +6       ;  PLIEN = Panel IEN

 +7       ;

 +8        NEW UID,II,DFN

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

 +10       SET DATA=$NAME(^TMP("BQIPLDFN",UID))

 +11       KILL @DATA

 +12      ;

 +13       SET II=0

 +14      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +15      ;

 +16       SET @DATA@(II)="I00010DFN"_$CHAR(30)

 +17       SET DFN=0

 +18       FOR 

               SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))

               IF 'DFN

                   QUIT 

               Begin DoDot:1

 +19               IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"

                       QUIT 

 +20               SET II=II+1

                   SET @DATA@(II)=DFN_$CHAR(30)

               End DoDot:1

 +21      ;

DONE      ; Finish the RPC call

 +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