- BQIPTTR ;VNGT/HS/ALA-Patient Triggers ; 15 Jan 2009 1:08 PM
- ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
- ;
- ;
- EDIN(DATA,DFN) ; EP -- BQI PATIENT TRIGGER EDIT
- ; Description - Initial Patient Edit trigger
- NEW UID,II,ETHN,VALUE,PGIEN,LGIEN,OIEN,VAL,BQIL,LGN,IEN
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTTR",UID))
- K @DATA
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT^T00030PROP_VALUE^T00001ABLE_FLAG"_$C(30)
- ;
- S ETHN=$$ETHN^BQIPTDMG(DFN,.01)
- S $P(VALUE,U,1)="AGMETH",$P(VALUE,U,4)="Method used to collect patient's ethnicity"
- S $P(VALUE,U,6)=$S(ETHN="":"N",1:"Y")
- ;
- S II=II+1,@DATA@(II)=VALUE_$C(30)
- ;
- D PAT9
- ;
- 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
- ;
- EN(DATA,AGETH) ; EP - BQI TRIGGER PAT ETHNICITY
- NEW UID,II
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTTR1",UID))
- K @DATA
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$C(30)
- S AGETH=$G(AGETH,"")
- I AGETH'="" S II=II+1,@DATA@(II)="AGMETH^Y^"_$C(30)
- I AGETH="" S II=II+1,@DATA@(II)="AGMETH^N^AGMETH"_$C(30)
- ;
- G DONE
- ;
- PAT9 ;EP - Patch 9
- K BQIL
- ; Languages
- S IEN="B",VAL="",LGIEN=""
- S IEN=$O(^AUPNPAT(DFN,86,IEN),-1)
- I +IEN'=0 D
- . S LGIEN=$P($G(^AUPNPAT(DFN,86,IEN,0)),U,4)
- . S PGIEN=$P($G(^AUPNPAT(DFN,86,IEN,0)),U,2)
- . I LGIEN'="" S BQIL(LGIEN)=""
- . I PGIEN'="" S BQIL(PGIEN)=""
- . S OIEN=0
- . F S OIEN=$O(^AUPNPAT(DFN,86,IEN,5,OIEN)) Q:'OIEN D
- .. I $G(^AUTTLANG(OIEN,0))="" Q
- .. S BQIL(OIEN)=""
- ;
- S LGN=""
- F S LGN=$O(BQIL(LGN)) Q:LGN="" S VAL=VAL_LGN_$C(29)_$P(^AUTTLANG(LGN,0),U,1)_$C(28)
- S VAL=$$TKO^BQIUL1(VAL,$C(28))
- S $P(VALUE,U,1)="PFLANG",$P(VALUE,U,6)="Y",$P(VALUE,U,4)="Select one of the user's languages",$P(VALUE,U,2)="T"
- S $P(VALUE,U,3)=VAL,II=II+1,@DATA@(II)=VALUE_$C(30)
- ;
- S VAL=""
- I LGIEN'="" S VAL=LGIEN_$C(28)_$P(^AUTTLANG(LGIEN,0),U,1)
- S $P(VALUE,U,1)="PFLANG",$P(VALUE,U,6)="Y",$P(VALUE,U,4)="",$P(VALUE,U,2)="T"
- S $P(VALUE,U,3)=VAL,II=II+1,@DATA@(II)=VALUE_$C(30)
- Q
- BQIPTTR ;VNGT/HS/ALA-Patient Triggers ; 15 Jan 2009 1:08 PM
- +1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
- +2 ;
- +3 ;
- EDIN(DATA,DFN) ; EP -- BQI PATIENT TRIGGER EDIT
- +1 ; Description - Initial Patient Edit trigger
- +2 NEW UID,II,ETHN,VALUE,PGIEN,LGIEN,OIEN,VAL,BQIL,LGN,IEN
- +3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +4 SET DATA=$NAME(^TMP("BQIPTTR",UID))
- +5 KILL @DATA
- +6 SET II=0
- +7 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER"
- +8 ;
- +9 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT^T00030PROP_VALUE^T00001ABLE_FLAG"_$CHAR(30)
- +10 ;
- +11 SET ETHN=$$ETHN^BQIPTDMG(DFN,.01)
- +12 SET $PIECE(VALUE,U,1)="AGMETH"
- SET $PIECE(VALUE,U,4)="Method used to collect patient's ethnicity"
- +13 SET $PIECE(VALUE,U,6)=$SELECT(ETHN="":"N",1:"Y")
- +14 ;
- +15 SET II=II+1
- SET @DATA@(II)=VALUE_$CHAR(30)
- +16 ;
- +17 DO PAT9
- +18 ;
- 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 ;
- EN(DATA,AGETH) ; EP - BQI TRIGGER PAT ETHNICITY
- +1 NEW UID,II
- +2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +3 SET DATA=$NAME(^TMP("BQIPTTR1",UID))
- +4 KILL @DATA
- +5 SET II=0
- +6 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER"
- +7 ;
- +8 SET @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$CHAR(30)
- +9 SET AGETH=$GET(AGETH,"")
- +10 IF AGETH'=""
- SET II=II+1
- SET @DATA@(II)="AGMETH^Y^"_$CHAR(30)
- +11 IF AGETH=""
- SET II=II+1
- SET @DATA@(II)="AGMETH^N^AGMETH"_$CHAR(30)
- +12 ;
- +13 GOTO DONE
- +14 ;
- PAT9 ;EP - Patch 9
- +1 KILL BQIL
- +2 ; Languages
- +3 SET IEN="B"
- SET VAL=""
- SET LGIEN=""
- +4 SET IEN=$ORDER(^AUPNPAT(DFN,86,IEN),-1)
- +5 IF +IEN'=0
- Begin DoDot:1
- +6 SET LGIEN=$PIECE($GET(^AUPNPAT(DFN,86,IEN,0)),U,4)
- +7 SET PGIEN=$PIECE($GET(^AUPNPAT(DFN,86,IEN,0)),U,2)
- +8 IF LGIEN'=""
- SET BQIL(LGIEN)=""
- +9 IF PGIEN'=""
- SET BQIL(PGIEN)=""
- +10 SET OIEN=0
- +11 FOR
- SET OIEN=$ORDER(^AUPNPAT(DFN,86,IEN,5,OIEN))
- IF 'OIEN
- QUIT
- Begin DoDot:2
- +12 IF $GET(^AUTTLANG(OIEN,0))=""
- QUIT
- +13 SET BQIL(OIEN)=""
- End DoDot:2
- End DoDot:1
- +14 ;
- +15 SET LGN=""
- +16 FOR
- SET LGN=$ORDER(BQIL(LGN))
- IF LGN=""
- QUIT
- SET VAL=VAL_LGN_$CHAR(29)_$PIECE(^AUTTLANG(LGN,0),U,1)_$CHAR(28)
- +17 SET VAL=$$TKO^BQIUL1(VAL,$CHAR(28))
- +18 SET $PIECE(VALUE,U,1)="PFLANG"
- SET $PIECE(VALUE,U,6)="Y"
- SET $PIECE(VALUE,U,4)="Select one of the user's languages"
- SET $PIECE(VALUE,U,2)="T"
- +19 SET $PIECE(VALUE,U,3)=VAL
- SET II=II+1
- SET @DATA@(II)=VALUE_$CHAR(30)
- +20 ;
- +21 SET VAL=""
- +22 IF LGIEN'=""
- SET VAL=LGIEN_$CHAR(28)_$PIECE(^AUTTLANG(LGIEN,0),U,1)
- +23 SET $PIECE(VALUE,U,1)="PFLANG"
- SET $PIECE(VALUE,U,6)="Y"
- SET $PIECE(VALUE,U,4)=""
- SET $PIECE(VALUE,U,2)="T"
- +24 SET $PIECE(VALUE,U,3)=VAL
- SET II=II+1
- SET @DATA@(II)=VALUE_$CHAR(30)
- +25 QUIT
