BQIPLPT.m

BQIPLPT ;PRXM/HC/ALA-Get Patient List by Panel ; 27 Oct 2005  2:14 PM

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

 ;

 Q

 ;

EN(DATA,OWNR,PLIEN) ; EP -- BQI GET PATIENT LIST BY PANEL

 ;

 ;Description

 ;  Gets a list of patients by owner and panel in the designated

 ;  display order

 ;Input

 ;  OWNR  - owner of the panel

 ;  PLIEN - panel internal entry number

 ;Output

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

 ;          is stored

 ;

 NEW UID,II,PDFN,X

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

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

 K @DATA

 ;

 S II=0

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

 ;

 ;  if no patients in panel, get header and return empty values

 I $O(^BQICARE(OWNR,1,PLIEN,40,0))="" D HDR G DONE

 ;

 ;  for every patient in the panel, get the patient list data in display order

 S PDFN=0

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

 . D EN^BQIPLVWP(.DATA,OWNR,PLIEN,PDFN)

 ;

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

 ;

HDR ;EP - Get the header if no patients are in the file

 NEW LIEN,NIEN

 D EN^BQIPLVWP(.DATA,OWNR,PLIEN,"")

 S LIEN=""

 S LIEN=$O(@DATA@(LIEN),-1) Q:'LIEN

 I LIEN=1,$P(@DATA@(LIEN),$C(30),1)?1."^" K @DATA@(LIEN) S II=II-1

 Q

BQIPLPT   ;PRXM/HC/ALA-Get Patient List by Panel ; 27 Oct 2005  2:14 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

EN(DATA,OWNR,PLIEN) ; EP -- BQI GET PATIENT LIST BY PANEL

 +1       ;

 +2       ;Description

 +3       ;  Gets a list of patients by owner and panel in the designated

 +4       ;  display order

 +5       ;Input

 +6       ;  OWNR  - owner of the panel

 +7       ;  PLIEN - panel internal entry number

 +8       ;Output

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

 +10      ;          is stored

 +11      ;

 +12       NEW UID,II,PDFN,X

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

 +14       SET DATA=$NAME(^TMP("BQIPLPT",UID))

 +15       KILL @DATA

 +16      ;

 +17       SET II=0

 +18      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +19      ;

 +20      ;  if no patients in panel, get header and return empty values

 +21       IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,0))=""

               DO HDR

               GOTO DONE

 +22      ;

 +23      ;  for every patient in the panel, get the patient list data in display order

 +24       SET PDFN=0

 +25       FOR 

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

               IF 'PDFN

                   QUIT 

               Begin DoDot:1

 +26               DO EN^BQIPLVWP(.DATA,OWNR,PLIEN,PDFN)

               End DoDot:1

 +27      ;

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 

 +7       ;

HDR       ;EP - Get the header if no patients are in the file

 +1        NEW LIEN,NIEN

 +2        DO EN^BQIPLVWP(.DATA,OWNR,PLIEN,"")

 +3        SET LIEN=""

 +4        SET LIEN=$ORDER(@DATA@(LIEN),-1)

           IF 'LIEN

               QUIT 

 +5        IF LIEN=1

               IF $PIECE(@DATA@(LIEN),$CHAR(30),1)?1."^"

                   KILL @DATA@(LIEN)

                   SET II=II-1

 +6        QUIT