BQIRGTH2.m

BQIRGTH2 ;VNGT/HS/ALA - HMS ARV Multiple Trigger ; 16 Jul 2008  10:40 AM

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

 ;

EN(DATA,ARASTAT) ; EP -- BQI REGISTER ARV TRIGGERS

 ; These are small individual value triggers

 ; Input

 ;   ARSTAT - ARV Appropriate Status (BKMHTAST)

 ;

 NEW UID,II

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

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

 K @DATA

 S II=0

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

 ;

 S @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$C(30)

 ;

 I $G(ARASTAT)="N" S II=II+1,@DATA@(II)="BKMHTNAR^Y^"_$C(30)

 I $G(ARASTAT)'="N" S II=II+1,@DATA@(II)="BKMHTNAR^N^BKMHTNAR"_$C(30)

 ;

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

 ;

REG(DATA,REGMN) ;EP -- BQI REG ARV REGIMEN TRIGGER

 NEW UID,II

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

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

 K @DATA

 S II=0

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

 ;

 S @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T00001REQ_OPT^T01024CLEAR_FIELDS"_$C(30)

 ;

 I $G(REGMN)="N" S II=II+1,@DATA@(II)="BKMHSCOM^Y^R^"_$C(30)

 I $G(REGMN)'="N" S II=II+1,@DATA@(II)="BKMHSCOM^Y^O^"_$C(30)

 G DONE

BQIRGTH2  ;VNGT/HS/ALA - HMS ARV Multiple Trigger ; 16 Jul 2008  10:40 AM

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

 +2       ;

EN(DATA,ARASTAT) ; EP -- BQI REGISTER ARV TRIGGERS

 +1       ; These are small individual value triggers

 +2       ; Input

 +3       ;   ARSTAT - ARV Appropriate Status (BKMHTAST)

 +4       ;

 +5        NEW UID,II

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

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

 +8        KILL @DATA

 +9        SET II=0

 +10      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +11      ;

 +12       SET @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$CHAR(30)

 +13      ;

 +14       IF $GET(ARASTAT)="N"

               SET II=II+1

               SET @DATA@(II)="BKMHTNAR^Y^"_$CHAR(30)

 +15       IF $GET(ARASTAT)'="N"

               SET II=II+1

               SET @DATA@(II)="BKMHTNAR^N^BKMHTNAR"_$CHAR(30)

 +16      ;

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       ;

REG(DATA,REGMN) ;EP -- BQI REG ARV REGIMEN TRIGGER

 +1        NEW UID,II

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

 +3        SET DATA=$NAME(^TMP("BQIRGTH3",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +7       ;

 +8        SET @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T00001REQ_OPT^T01024CLEAR_FIELDS"_$CHAR(30)

 +9       ;

 +10       IF $GET(REGMN)="N"

               SET II=II+1

               SET @DATA@(II)="BKMHSCOM^Y^R^"_$CHAR(30)

 +11       IF $GET(REGMN)'="N"

               SET II=II+1

               SET @DATA@(II)="BKMHSCOM^Y^O^"_$CHAR(30)

 +12       GOTO DONE