- 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
