- BQIMTCRT ;GDIT/HS/ALA-Matched Criteria Utilities ; 23 Jan 2013 12:42 PM
- ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- ;
- ;
- TAB(DATA,OWNR,PLIEN) ;EP -- BQI GET MATCH CRITERIA DROP
- NEW UID,II
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIMTCRT",UID))
- K @DATA
- ;
- S II=0
- D THDR
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMTCRT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- I $P(^BQICARE(OWNR,1,PLIEN,0),U,10)=0 G DONE
- NEW DA,IENS,TYPE,SOURCE,FSOURCE,PPIEN,ARRAY
- S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
- S SOURCE=$$GET1^DIQ(90505.01,IENS,.11,"E")
- I SOURCE="INPATIENTS" S ARRAY("IN")="IN^Inpatients"
- I SOURCE="ER VISITS" S ARRAY("ER")="ER^ER Visits"
- ;I SOURCE="RPMS REGISTER PATIENTS" S ARRAY("RG")="RG^Register"
- S FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
- S PPIEN=$$PP^BQIDCDF(FSOURCE) I PPIEN=-1 G CONT
- ;
- F TYPE="PROB","MED","LAB","ALLERGY","MEDTX","LABTX","PROBTX","CPT","CPTTX","EDUPICK","EDUTX","EDUC","EDUTOP","REMCODE","POV","POVTX","POVS","POVSB","MEAS" D
- . I '$D(^BQICARE(OWNR,1,PLIEN,15,"B",TYPE)) Q
- . I TYPE="PROB"!(TYPE="PROBTX") S ARRAY("PR")="PR^Problems"
- . I TYPE="POV"!(TYPE="POVS")!(TYPE="POVTX")!(TYPE="POVSB") S ARRAY("DX")="DX^POVs"
- . I TYPE="MEAS" S ARRAY("MS")="MS^Measurements"
- . I TYPE="MED"!(TYPE="MEDTX") D
- .. I $D(^BQICARE(OWNR,1,PLIEN,15,"B","MNOT")) Q
- .. S ARRAY("ME")="ME^Medications"
- . I TYPE="LAB"!(TYPE="LABTX") D
- .. I $D(^BQICARE(OWNR,1,PLIEN,15,"B","LNOT")) Q
- .. S ARRAY("LA")="LA^Lab Tests"
- . I TYPE="ALLERGY" S ARRAY("AL")="AL^Allergies"
- . I TYPE="CPT"!(TYPE="CPTTX") D
- .. I $D(^BQICARE(OWNR,1,PLIEN,15,"B","CNOT")) Q
- .. S ARRAY("CP")="CP^CPTs"
- . I TYPE="EDUC"!(TYPE="EDUPICK")!(TYPE="EDUTX")!(TYPE="EDUTOP") D
- .. I $D(^BQICARE(OWNR,1,PLIEN,15,"B","EDUNOT")) Q
- .. S ARRAY("ED")="ED^Pt Education"
- . I TYPE="REMCODE" S ARRAY("RE")="RE^Reminder Notifications"
- ;
- CONT ;
- NEW TIEN
- S TYPE=""
- F S TYPE=$O(ARRAY(TYPE)) Q:TYPE="" D
- . S TIEN=$O(^BQI(90506.5,"C",TYPE,"")) I TIEN="" Q
- . I $P(^BQI(90506.5,TIEN,0),"^",10)=1 Q
- . S II=II+1,@DATA@(II)=ARRAY(TYPE)_$C(30)
- ;
- DONE ;
- I '$G(NFLG) 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
- ;
- THDR ;
- S @DATA@(II)="T00010IEN^T00030NAME"_$C(30)
- Q
- ;
- ;
- COL(DATA,TYPE) ;EP -- BQI GET MATCH CRITERIA COLUMN
- NEW UID,II
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIMTCRT",UID))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMTCRT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;S MTYP=$S(TYPE="PR":"PROB",TYPE="ME":"MED",TYPE="LA":"LAB",TYPE="IN":"INP",TYPE="CP":"CPT",TYPE="AL":"ALGY",1:"") I MTYP="" Q
- S HDR="T00015CODE^T00050DISPLAY_NAME"
- S @DATA@(II)=HDR_$C(30)
- ;
- NEW CRIEN,TYP,ORD,IEN,KEY,CODE
- S CRIEN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")
- S TYP=$P(^BQI(90506.5,CRIEN,0),U,2)
- S ORD=""
- F S ORD=$O(^BQI(90506.1,"AD",TYP,ORD)) Q:ORD="" D
- . S IEN=""
- . F S IEN=$O(^BQI(90506.1,"AD",TYP,ORD,IEN)) Q:IEN="" D
- .. I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
- .. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
- .. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
- .. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
- ... S CODE=$P(^BQI(90506.1,IEN,0),U,1) Q:CODE=""
- ... I $P($G(^BQI(90506.1,IEN,0)),U,10)=1 Q
- ... S II=II+1,@DATA@(II)=CODE_U_$P(^BQI(90506.1,IEN,0),U,3)_$C(30)
- ;
- NEW CRIEN,BN,CDATA,CODE
- S CRIEN=$$FIND1^DIC(90506.5,,"X",TYPE,"C","","ERROR")
- S BN=0
- F S BN=$O(^BQI(90506.5,CRIEN,10,BN)) Q:'BN D
- . S CDATA=^BQI(90506.5,CRIEN,10,BN,0)
- . S CODE=$P(CDATA,U,1)
- . S II=II+1,@DATA@(II)=CODE_U_$P(CDATA,U,3)_$C(30)
- S II=II+1,@DATA@(II)=$C(31)
- Q
- BQIMTCRT ;GDIT/HS/ALA-Matched Criteria Utilities ; 23 Jan 2013 12:42 PM
- +1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- +2 ;
- +3 ;
- TAB(DATA,OWNR,PLIEN) ;EP -- BQI GET MATCH CRITERIA DROP
- +1 NEW UID,II
- +2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +3 SET DATA=$NAME(^TMP("BQIMTCRT",UID))
- +4 KILL @DATA
- +5 ;
- +6 SET II=0
- +7 DO THDR
- +8 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIMTCRT D UNWIND^%ZTER"
- +9 ;
- +10 IF $PIECE(^BQICARE(OWNR,1,PLIEN,0),U,10)=0
- GOTO DONE
- +11 NEW DA,IENS,TYPE,SOURCE,FSOURCE,PPIEN,ARRAY
- +12 SET DA(1)=OWNR
- SET DA=PLIEN
- SET IENS=$$IENS^DILF(.DA)
- +13 SET SOURCE=$$GET1^DIQ(90505.01,IENS,.11,"E")
- +14 IF SOURCE="INPATIENTS"
- SET ARRAY("IN")="IN^Inpatients"
- +15 IF SOURCE="ER VISITS"
- SET ARRAY("ER")="ER^ER Visits"
- +16 ;I SOURCE="RPMS REGISTER PATIENTS" S ARRAY("RG")="RG^Register"
- +17 SET FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
- +18 SET PPIEN=$$PP^BQIDCDF(FSOURCE)
- IF PPIEN=-1
- GOTO CONT
- +19 ;
- +20 FOR TYPE="PROB","MED","LAB","ALLERGY","MEDTX","LABTX","PROBTX","CPT","CPTTX","EDUPICK","EDUTX","EDUC","EDUTOP","REMCODE","POV","POVTX","POVS","POVSB","MEAS"
- Begin DoDot:1
- +21 IF '$DATA(^BQICARE(OWNR,1,PLIEN,15,"B",TYPE))
- QUIT
- +22 IF TYPE="PROB"!(TYPE="PROBTX")
- SET ARRAY("PR")="PR^Problems"
- +23 IF TYPE="POV"!(TYPE="POVS")!(TYPE="POVTX")!(TYPE="POVSB")
- SET ARRAY("DX")="DX^POVs"
- +24 IF TYPE="MEAS"
- SET ARRAY("MS")="MS^Measurements"
- +25 IF TYPE="MED"!(TYPE="MEDTX")
- Begin DoDot:2
- +26 IF $DATA(^BQICARE(OWNR,1,PLIEN,15,"B","MNOT"))
- QUIT
- +27 SET ARRAY("ME")="ME^Medications"
- End DoDot:2
- +28 IF TYPE="LAB"!(TYPE="LABTX")
- Begin DoDot:2
- +29 IF $DATA(^BQICARE(OWNR,1,PLIEN,15,"B","LNOT"))
- QUIT
- +30 SET ARRAY("LA")="LA^Lab Tests"
- End DoDot:2
- +31 IF TYPE="ALLERGY"
- SET ARRAY("AL")="AL^Allergies"
- +32 IF TYPE="CPT"!(TYPE="CPTTX")
- Begin DoDot:2
- +33 IF $DATA(^BQICARE(OWNR,1,PLIEN,15,"B","CNOT"))
- QUIT
- +34 SET ARRAY("CP")="CP^CPTs"
- End DoDot:2
- +35 IF TYPE="EDUC"!(TYPE="EDUPICK")!(TYPE="EDUTX")!(TYPE="EDUTOP")
- Begin DoDot:2
- +36 IF $DATA(^BQICARE(OWNR,1,PLIEN,15,"B","EDUNOT"))
- QUIT
- +37 SET ARRAY("ED")="ED^Pt Education"
- End DoDot:2
- +38 IF TYPE="REMCODE"
- SET ARRAY("RE")="RE^Reminder Notifications"
- End DoDot:1
- +39 ;
- CONT ;
- +1 NEW TIEN
- +2 SET TYPE=""
- +3 FOR
- SET TYPE=$ORDER(ARRAY(TYPE))
- IF TYPE=""
- QUIT
- Begin DoDot:1
- +4 SET TIEN=$ORDER(^BQI(90506.5,"C",TYPE,""))
- IF TIEN=""
- QUIT
- +5 IF $PIECE(^BQI(90506.5,TIEN,0),"^",10)=1
- QUIT
- +6 SET II=II+1
- SET @DATA@(II)=ARRAY(TYPE)_$CHAR(30)
- End DoDot:1
- +7 ;
- DONE ;
- +1 IF '$GET(NFLG)
- 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 ;
- THDR ;
- +1 SET @DATA@(II)="T00010IEN^T00030NAME"_$CHAR(30)
- +2 QUIT
- +3 ;
- +4 ;
- COL(DATA,TYPE) ;EP -- BQI GET MATCH CRITERIA COLUMN
- +1 NEW UID,II
- +2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +3 SET DATA=$NAME(^TMP("BQIMTCRT",UID))
- +4 KILL @DATA
- +5 ;
- +6 SET II=0
- +7 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIMTCRT D UNWIND^%ZTER"
- +8 ;S MTYP=$S(TYPE="PR":"PROB",TYPE="ME":"MED",TYPE="LA":"LAB",TYPE="IN":"INP",TYPE="CP":"CPT",TYPE="AL":"ALGY",1:"") I MTYP="" Q
- +9 SET HDR="T00015CODE^T00050DISPLAY_NAME"
- +10 SET @DATA@(II)=HDR_$CHAR(30)
- +11 ;
- +12 NEW CRIEN,TYP,ORD,IEN,KEY,CODE
- +13 SET CRIEN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")
- +14 SET TYP=$PIECE(^BQI(90506.5,CRIEN,0),U,2)
- +15 SET ORD=""
- +16 FOR
- SET ORD=$ORDER(^BQI(90506.1,"AD",TYP,ORD))
- IF ORD=""
- QUIT
- Begin DoDot:1
- +17 SET IEN=""
- +18 FOR
- SET IEN=$ORDER(^BQI(90506.1,"AD",TYP,ORD,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:2
- +19 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
- QUIT
- +20 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
- +21 IF KEY'=""
- IF '$$KEYCHK^BQIULSC(KEY,DUZ)
- QUIT
- +22 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
- Begin DoDot:3
- +23 SET CODE=$PIECE(^BQI(90506.1,IEN,0),U,1)
- IF CODE=""
- QUIT
- +24 IF $PIECE($GET(^BQI(90506.1,IEN,0)),U,10)=1
- QUIT
- +25 SET II=II+1
- SET @DATA@(II)=CODE_U_$PIECE(^BQI(90506.1,IEN,0),U,3)_$CHAR(30)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +26 ;
- +27 NEW CRIEN,BN,CDATA,CODE
- +28 SET CRIEN=$$FIND1^DIC(90506.5,,"X",TYPE,"C","","ERROR")
- +29 SET BN=0
- +30 FOR
- SET BN=$ORDER(^BQI(90506.5,CRIEN,10,BN))
- IF 'BN
- QUIT
- Begin DoDot:1
- +31 SET CDATA=^BQI(90506.5,CRIEN,10,BN,0)
- +32 SET CODE=$PIECE(CDATA,U,1)
- +33 SET II=II+1
- SET @DATA@(II)=CODE_U_$PIECE(CDATA,U,3)_$CHAR(30)
- End DoDot:1
- +34 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +35 QUIT
