BQIRRPT ;PRXM/HC/ALA-Reports List ; 17 Oct 2007 6:24 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
EN(DATA,REG) ;EP -- BQI REPORT LIST
;
; Input
; REG - Include reports for the passed register
;
NEW UID,BQII,RPTNM,IEN,DESC,DN,DIS,DEF,RPC,RGIEN,TYP,NOP,TAX,TXCK
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRRPT",UID))
K @DATA
;
S BQII=0,REG=$G(REG,"")
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRRPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(BQII)="T00030REPORT_NAME^T00040RPC^T00040DEFINITION^T00001DISPLAY_TYPE^T00030REPORT_TYPE^T00001NO_PARAMETER^T00030TAX_CHECK"_$C(30)
;
S RPTNM=""
F S RPTNM=$O(^BQI(90506.6,"B",RPTNM)) Q:RPTNM="" D
. ;Temporary Check for Asthma Action Plan - Does not exist before BJPC 2.0
. I RPTNM="Asthma Action Plan",$$VERSION^XPDUTL("BJPC")<2.0 Q
. S IEN=""
. F S IEN=$O(^BQI(90506.6,"B",RPTNM,IEN)) Q:IEN="" D
.. I $P(^BQI(90506.6,IEN,0),U,4)=1 Q
.. S RPC=$P(^BQI(90506.6,IEN,0),U,2)
.. S DEF=$$GET1^DIQ(90506.6,IEN_",",.03,"E")
.. ; Temporary check for BJPC 2.0 which includes new Patient Wellness Handout with associated type
.. I RPTNM="Patient Wellness Handout" D
... S RESULT=$$VERSION^XPDUTL("BJPC") S RESULT=$S(RESULT<2.0:0,1:1)
... I 'RESULT S DEF=""
.. S DIS=$$GET1^DIQ(90506.6,IEN_",",.05,"I")
.. S TYP=$$GET1^DIQ(90506.6,IEN_",",.06,"E")
.. S NOP=$$GET1^DIQ(90506.6,IEN_",",.07,"I")
.. S TAX=$$GET1^DIQ(90506.6,IEN_",",.08,"E")
.. S BQII=BQII+1,@DATA@(BQII)=RPTNM_"^"_RPC_"^"_DEF_"^"_DIS_"^"_TYP_"^"_NOP_"^"_TAX_$C(30)
;
; ** If including a register, pull those reports **
I REG'="" D
. S RGIEN=$O(^BQI(90507,"B",REG,"")) I RGIEN="" Q
. S IEN=0
. F S IEN=$O(^BQI(90507,RGIEN,20,IEN)) Q:'IEN D
.. I $P(^BQI(90507,RGIEN,20,IEN,0),U,4)=1 Q
.. S RPTNM=$P(^BQI(90507,RGIEN,20,IEN,0),U,1)
.. S RPC=$P(^BQI(90507,RGIEN,20,IEN,0),U,2)
.. NEW DA,IENS,TYP
.. S DA(1)=RGIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S DEF=$$GET1^DIQ(90507.02,IENS_",",.03,"E")
.. S TYP=$$GET1^DIQ(90507.02,IENS_",",.05,"E")
.. S DIS=$$GET1^DIQ(90507.02,IENS_",",.06,"I")
.. S NOP=$$GET1^DIQ(90507.02,IENS_",",.07,"I")
.. S TXCK=$$GET1^DIQ(90507.02,IENS_",",.08,"I")
.. S TAX="" I TXCK S TAX=$P(^BQI(90507,RGIEN,0),U,1)
.. S BQII=BQII+1,@DATA@(BQII)=RPTNM_"^"_RPC_"^"_DEF_"^"_DIS_"^"_TYP_"^"_NOP_"^"_TAX_$C(30)
S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
;
ERR ;Error trap
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
BQIRRPT ;PRXM/HC/ALA-Reports List ; 17 Oct 2007 6:24 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
EN(DATA,REG) ;EP -- BQI REPORT LIST
+1 ;
+2 ; Input
+3 ; REG - Include reports for the passed register
+4 ;
+5 NEW UID,BQII,RPTNM,IEN,DESC,DN,DIS,DEF,RPC,RGIEN,TYP,NOP,TAX,TXCK
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BQIRRPT",UID))
+8 KILL @DATA
+9 ;
+10 SET BQII=0
SET REG=$GET(REG,"")
+11 ;
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRRPT D UNWIND^%ZTER"
+13 ;
+14 SET @DATA@(BQII)="T00030REPORT_NAME^T00040RPC^T00040DEFINITION^T00001DISPLAY_TYPE^T00030REPORT_TYPE^T00001NO_PARAMETER^T00030TAX_CHECK"_$CHAR(30)
+15 ;
+16 SET RPTNM=""
+17 FOR
SET RPTNM=$ORDER(^BQI(90506.6,"B",RPTNM))
IF RPTNM=""
QUIT
Begin DoDot:1
+18 ;Temporary Check for Asthma Action Plan - Does not exist before BJPC 2.0
+19 IF RPTNM="Asthma Action Plan"
IF $$VERSION^XPDUTL("BJPC")<2.0
QUIT
+20 SET IEN=""
+21 FOR
SET IEN=$ORDER(^BQI(90506.6,"B",RPTNM,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+22 IF $PIECE(^BQI(90506.6,IEN,0),U,4)=1
QUIT
+23 SET RPC=$PIECE(^BQI(90506.6,IEN,0),U,2)
+24 SET DEF=$$GET1^DIQ(90506.6,IEN_",",.03,"E")
+25 ; Temporary check for BJPC 2.0 which includes new Patient Wellness Handout with associated type
+26 IF RPTNM="Patient Wellness Handout"
Begin DoDot:3
+27 SET RESULT=$$VERSION^XPDUTL("BJPC")
SET RESULT=$SELECT(RESULT<2.0:0,1:1)
+28 IF 'RESULT
SET DEF=""
End DoDot:3
+29 SET DIS=$$GET1^DIQ(90506.6,IEN_",",.05,"I")
+30 SET TYP=$$GET1^DIQ(90506.6,IEN_",",.06,"E")
+31 SET NOP=$$GET1^DIQ(90506.6,IEN_",",.07,"I")
+32 SET TAX=$$GET1^DIQ(90506.6,IEN_",",.08,"E")
+33 SET BQII=BQII+1
SET @DATA@(BQII)=RPTNM_"^"_RPC_"^"_DEF_"^"_DIS_"^"_TYP_"^"_NOP_"^"_TAX_$CHAR(30)
End DoDot:2
End DoDot:1
+34 ;
+35 ; ** If including a register, pull those reports **
+36 IF REG'=""
Begin DoDot:1
+37 SET RGIEN=$ORDER(^BQI(90507,"B",REG,""))
IF RGIEN=""
QUIT
+38 SET IEN=0
+39 FOR
SET IEN=$ORDER(^BQI(90507,RGIEN,20,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+40 IF $PIECE(^BQI(90507,RGIEN,20,IEN,0),U,4)=1
QUIT
+41 SET RPTNM=$PIECE(^BQI(90507,RGIEN,20,IEN,0),U,1)
+42 SET RPC=$PIECE(^BQI(90507,RGIEN,20,IEN,0),U,2)
+43 NEW DA,IENS,TYP
+44 SET DA(1)=RGIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+45 SET DEF=$$GET1^DIQ(90507.02,IENS_",",.03,"E")
+46 SET TYP=$$GET1^DIQ(90507.02,IENS_",",.05,"E")
+47 SET DIS=$$GET1^DIQ(90507.02,IENS_",",.06,"I")
+48 SET NOP=$$GET1^DIQ(90507.02,IENS_",",.07,"I")
+49 SET TXCK=$$GET1^DIQ(90507.02,IENS_",",.08,"I")
+50 SET TAX=""
IF TXCK
SET TAX=$PIECE(^BQI(90507,RGIEN,0),U,1)
+51 SET BQII=BQII+1
SET @DATA@(BQII)=RPTNM_"^"_RPC_"^"_DEF_"^"_DIS_"^"_TYP_"^"_NOP_"^"_TAX_$CHAR(30)
End DoDot:2
End DoDot:1
+52 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+53 QUIT
+54 ;
ERR ;Error trap
+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
