BQIDCEPL.m

BQIDCEPL ;VNGT/HS/ALA-Patients from an EHR Personal List ; 06 Nov 2008  2:58 PM

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

 ;

 Q

 ;

EPL(NDATA,PARMS,MPARMS) ;EP

 ;

 ;Description

 ;  Executable to retrieve those patients which are on a specified EHR personal list

 ;Input

 ;  PARMS = Array of parameters and their values

 ;  MPARMS = Multiple array of a parameter

 ;Expected to return DATA

 ;

 NEW UID,II,BQ,DFN,EHRPLIEN

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

 S NDATA=$NA(^TMP("BQIDCEPL",UID))

 K @NDATA

 ;

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

 S NM=""

 F  S NM=$O(PARMS(NM)) Q:NM=""  S @NM=PARMS(NM)

 ;

 ;Parameters

 ;  EHRPLIEN = EHR Personal List internal entry number

 ;

 I $D(MPARMS("EHRPLIEN"))>0 D

 . S EHRPLIEN=""

 . F  S EHRPLIEN=$O(MPARMS("EHRPLIEN",EHRPLIEN)) Q:EHRPLIEN=""  D FND

 I '$D(MPARMS("EHRPLIEN")) D FND

 ;

 Q

 ;

FND ;

 I $G(^XTV(8989.5,EHRPLIEN,0))="" D MSG Q

 D PLSTPTS^BEHOPTP2(.TDATA,EHRPLIEN)

 ;

 S BQ=0

 F  S BQ=$O(TDATA(BQ)) Q:BQ=""  D

 . S DFN=$P(TDATA(BQ),U,1) I DFN="" Q

 . S @NDATA@(DFN)=""

 K TDATA

 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(NDATA) S II=II+1,@NDATA@(II)=$C(31)

 Q

 ;

MSG ;

 NEW MSG,FLAG,MTEXT

 S MSG="EHR Personal List Problem"

 S FLAG="" I $G(ZTSK)'="" S FLAG=1

 S MTEXT(1,0)="One or more of the EHR Personal Lists used in panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" appears"

 S MTEXT(2,0)="to have been deleted from your server. The results of this panel may not be accurate."

 D ADD^BQINOTF("",OWNR,MSG,.MTEXT,FLAG)

 Q

BQIDCEPL  ;VNGT/HS/ALA-Patients from an EHR Personal List ; 06 Nov 2008  2:58 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

EPL(NDATA,PARMS,MPARMS) ;EP

 +1       ;

 +2       ;Description

 +3       ;  Executable to retrieve those patients which are on a specified EHR personal list

 +4       ;Input

 +5       ;  PARMS = Array of parameters and their values

 +6       ;  MPARMS = Multiple array of a parameter

 +7       ;Expected to return DATA

 +8       ;

 +9        NEW UID,II,BQ,DFN,EHRPLIEN

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

           SET II=0

 +11       SET NDATA=$NAME(^TMP("BQIDCEPL",UID))

 +12       KILL @NDATA

 +13      ;

 +14      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +15       SET NM=""

 +16       FOR 

               SET NM=$ORDER(PARMS(NM))

               IF NM=""

                   QUIT 

               SET @NM=PARMS(NM)

 +17      ;

 +18      ;Parameters

 +19      ;  EHRPLIEN = EHR Personal List internal entry number

 +20      ;

 +21       IF $DATA(MPARMS("EHRPLIEN"))>0

               Begin DoDot:1

 +22               SET EHRPLIEN=""

 +23               FOR 

                       SET EHRPLIEN=$ORDER(MPARMS("EHRPLIEN",EHRPLIEN))

                       IF EHRPLIEN=""

                           QUIT 

                       DO FND

               End DoDot:1

 +24       IF '$DATA(MPARMS("EHRPLIEN"))

               DO FND

 +25      ;

 +26       QUIT 

 +27      ;

FND       ;

 +1        IF $GET(^XTV(8989.5,EHRPLIEN,0))=""

               DO MSG

               QUIT 

 +2        DO PLSTPTS^BEHOPTP2(.TDATA,EHRPLIEN)

 +3       ;

 +4        SET BQ=0

 +5        FOR 

               SET BQ=$ORDER(TDATA(BQ))

               IF BQ=""

                   QUIT 

               Begin DoDot:1

 +6                SET DFN=$PIECE(TDATA(BQ),U,1)

                   IF DFN=""

                       QUIT 

 +7                SET @NDATA@(DFN)=""

               End DoDot:1

 +8        KILL TDATA

 +9        QUIT 

 +10      ;

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(NDATA)

                   SET II=II+1

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

 +6        QUIT 

 +7       ;

MSG       ;

 +1        NEW MSG,FLAG,MTEXT

 +2        SET MSG="EHR Personal List Problem"

 +3        SET FLAG=""

           IF $GET(ZTSK)'=""

               SET FLAG=1

 +4        SET MTEXT(1,0)="One or more of the EHR Personal Lists used in panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" appears"

 +5        SET MTEXT(2,0)="to have been deleted from your server. The results of this panel may not be accurate."

 +6        DO ADD^BQINOTF("",OWNR,MSG,.MTEXT,FLAG)

 +7        QUIT