BQIVFTRM.m

BQIVFTRM ;VNGT/HS/ALA-Trigger Measurement ; 13 May 2010  6:54 AM

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

 ;

 ;

EN(DATA,APCDTTYP) ;EP - BQI VFILE TRIGGER MEAS

 ;

 ; Input

 ;   TEXT  - Narrative Text

 ;

 NEW UID,II,VALUE,SOURCE,CLEAR,MSIEN

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

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

 K @DATA

 S II=0

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

 S APCDTTYP=$G(APCDTTYP)

 D HDR

 I APCDTTYP'?.N S MSIEN=$O(^AUTTMSR("B",APCDTTYP,""))

 S SOURCE="QUALIF",TYPE="C",VALUE="",HELP="",CLEAR=""

 I $O(^GMRD(120.52,"C",MSIEN,""))="" D  G DONE

 . S ABLE="N" D UP

 . S SOURCE="VITDTM",TYPE="D",VALUE="",HELP="",CLEAR="" D UP

 S IEN=""

 F  S IEN=$O(^GMRD(120.52,"C",MSIEN,IEN)) Q:IEN=""  D

 . S VALUE=VALUE_IEN_$C(29)_$P(^GMRD(120.52,IEN,0),U,1)_$C(28)

 S VALUE="BQIQLF="_$$TKO^BQIUL1(VALUE,$C(28)),ABLE="Y" D UP

 I VALUE'="" S SOURCE="VITDTM",TYPE="D",VALUE="",HELP="",CLEAR="" D UP

 ;

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

 ;

HDR ; Header for BQI VFILE TRIGGER MEAS

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

 Q

 ;

UP ; Update

 S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_ABLE_U_VALUE_U_HELP_U_CLEAR_$C(30)

 Q

BQIVFTRM  ;VNGT/HS/ALA-Trigger Measurement ; 13 May 2010  6:54 AM

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

 +2       ;

 +3       ;

EN(DATA,APCDTTYP) ;EP - BQI VFILE TRIGGER MEAS

 +1       ;

 +2       ; Input

 +3       ;   TEXT  - Narrative Text

 +4       ;

 +5        NEW UID,II,VALUE,SOURCE,CLEAR,MSIEN

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

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

 +8        KILL @DATA

 +9        SET II=0

 +10      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +11       SET APCDTTYP=$GET(APCDTTYP)

 +12       DO HDR

 +13       IF APCDTTYP'?.N

               SET MSIEN=$ORDER(^AUTTMSR("B",APCDTTYP,""))

 +14       SET SOURCE="QUALIF"

           SET TYPE="C"

           SET VALUE=""

           SET HELP=""

           SET CLEAR=""

 +15       IF $ORDER(^GMRD(120.52,"C",MSIEN,""))=""

               Begin DoDot:1

 +16               SET ABLE="N"

                   DO UP

 +17               SET SOURCE="VITDTM"

                   SET TYPE="D"

                   SET VALUE=""

                   SET HELP=""

                   SET CLEAR=""

                   DO UP

               End DoDot:1

               GOTO DONE

 +18       SET IEN=""

 +19       FOR 

               SET IEN=$ORDER(^GMRD(120.52,"C",MSIEN,IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +20               SET VALUE=VALUE_IEN_$CHAR(29)_$PIECE(^GMRD(120.52,IEN,0),U,1)_$CHAR(28)

               End DoDot:1

 +21       SET VALUE="BQIQLF="_$$TKO^BQIUL1(VALUE,$CHAR(28))

           SET ABLE="Y"

           DO UP

 +22       IF VALUE'=""

               SET SOURCE="VITDTM"

               SET TYPE="D"

               SET VALUE=""

               SET HELP=""

               SET CLEAR=""

               DO UP

 +23      ;

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       ;

HDR       ; Header for BQI VFILE TRIGGER MEAS

 +1        SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T01024PARMS^T00200HELP_TEXT^T01024CLEAR_FIELDS"_$CHAR(30)

 +2        QUIT 

 +3       ;

UP        ; Update

 +1        SET II=II+1

           SET @DATA@(II)=SOURCE_U_TYPE_U_ABLE_U_VALUE_U_HELP_U_CLEAR_$CHAR(30)

 +2        QUIT