BQIRPWH.m

BQIRPWH ;VNGT/HS/DB - Retrieve Patient Wellness Handout list  ; 04 Nov 2008  5:58 PM

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

 ;

 Q

 ;

 ; This function will gather a list of Patient Wellness Handout types and set them

 ; into a temporary global array for use by RPC: BQI PATIENT WELLNESS TYPE.

 ; 

 ; INPUT:

 ;       USER - The DUZ of the user selecting the Health summaries.

 ;

 ; OUTPUT:

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

 ;       ^TMP("BQIRPWH",UID,PATIENT WELLNESS IEN)

 ; 

PWHLST(DATA,FAKE)   ; EP -- BQI PATIENT WELLNESS TYPE

 ;

 ; Input

 ;  FAKE - extra 'blank' parameter required by BMXNET async 'feature'

 ;  

 N UID,PWHIEN,PWHNAME,BQII,X

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

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

 ; Initialize global array

 K @DATA

 S PWHIEN=0,BQII=1

 ;

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

 ;

 S @DATA@(BQII)="I00010PATIENT_WELLNESS_TYPE^T00030PATIENT_WELLNESS_TYPE_NM"_$C(30)

 F  S PWHIEN=$O(^APCHPWHT(PWHIEN)) Q:'PWHIEN  D

 .;get patient wellness handout type name.

 .S PWHNAME=$$GET1^DIQ(9001026,PWHIEN,.01,"E")

 .;Set target global for calling routine.

 .S BQII=BQII+1,@DATA@(BQII)=PWHIEN_"^"_PWHNAME_$C(30)

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

 Q

 ;

ERR ;Error trap for PWHLST

 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

BQIRPWH   ;VNGT/HS/DB - Retrieve Patient Wellness Handout list  ; 04 Nov 2008  5:58 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ; This function will gather a list of Patient Wellness Handout types and set them

 +6       ; into a temporary global array for use by RPC: BQI PATIENT WELLNESS TYPE.

 +7       ; 

 +8       ; INPUT:

 +9       ;       USER - The DUZ of the user selecting the Health summaries.

 +10      ;

 +11      ; OUTPUT:

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

 +13      ;       ^TMP("BQIRPWH",UID,PATIENT WELLNESS IEN)

 +14      ; 

PWHLST(DATA,FAKE) ; EP -- BQI PATIENT WELLNESS TYPE

 +1       ;

 +2       ; Input

 +3       ;  FAKE - extra 'blank' parameter required by BMXNET async 'feature'

 +4       ;  

 +5        NEW UID,PWHIEN,PWHNAME,BQII,X

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

 +7        SET DATA=$NAME(^TMP("BQIRPWH",UID))

 +8       ; Initialize global array

 +9        KILL @DATA

 +10       SET PWHIEN=0

           SET BQII=1

 +11      ;

 +12      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +13      ;

 +14       SET @DATA@(BQII)="I00010PATIENT_WELLNESS_TYPE^T00030PATIENT_WELLNESS_TYPE_NM"_$CHAR(30)

 +15       FOR 

               SET PWHIEN=$ORDER(^APCHPWHT(PWHIEN))

               IF 'PWHIEN

                   QUIT 

               Begin DoDot:1

 +16      ;get patient wellness handout type name.

 +17               SET PWHNAME=$$GET1^DIQ(9001026,PWHIEN,.01,"E")

 +18      ;Set target global for calling routine.

 +19               SET BQII=BQII+1

                   SET @DATA@(BQII)=PWHIEN_"^"_PWHNAME_$CHAR(30)

               End DoDot:1

 +20       SET BQII=BQII+1

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

 +21       QUIT 

 +22      ;

ERR       ;Error trap for PWHLST

 +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