BQIPTFHT.m

BQIPTFHT ;VNGT/HS/BEE-Trigger Family History Information ; 01 May 2009  3:21 PM

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

 Q

 ;

EN(DATA,TEXT,DXN) ;EP - BQI VFILE TRIGGER PRB

 ;

 ; Input

 ;   TEXT  - Narrative Text

 ;

 NEW UID,II,VALUE,NARR,SOURCE,CLEAR

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

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

 K @DATA

 S II=0

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

 S TEXT=$G(TEXT,""),DXN=$G(DXN,"")

 D HDR

 I DXN'="" D CLS

 I TEXT'="" D NAR

 ;

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

 ;

NAR ;EP - Narrative Text

 NEW SOURCE,VALUE,DIC,DLAYGO,X,Y,IEN

 S SOURCE="APCDN",VALUE=""

 S DIC(0)="LX",DIC="^AUTNPOV(",DLAYGO=9999999.27,X=TEXT

 D ^DIC

 S IEN=+Y

 I IEN=-1 K DO,DD D FILE^DICN S IEN=+Y

 S VALUE=IEN_$C(29)_TEXT

 S II=II+1,@DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_U_U_$C(30)

 Q

 ;

CLS ;EP - Problem Classification

 NEW SOURCE,VALUE,HELP,CLS,NUM,N

 S SOURCE="APCDCLAS",VALUE="",HELP=""

 I $$VERSION^XPDUTL("BJPC")<2.0 D  Q

 . S II=II+1,@DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"N"_U_HELP_U_$G(CLEAR)_$C(30)

 ; If diagnosis does not trigger a classification

 I '$$ASKCL^AUPNVPLC(DXN) D  Q

 . S CLEAR=SOURCE

 . S II=II+1,@DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"N"_U_HELP_U_$G(CLEAR)_$C(30)

 ;

 S CLS=$O(^APCDPLCL("B","ASTHMA SEVERITY","")) I CLS="" D  Q

 . S II=II+1,@DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"N"_U_HELP_U_$G(CLEAR)_$C(30)

 ;

 S N=0

 F  S N=$O(^APCDPLCL(CLS,11,N)) Q:'N  D

 . S NUM=$P(^APCDPLCL(CLS,11,N,0),U,1)

 . S VALUE=VALUE_NUM_$C(29)_NUM_"-"_$P(^APCDPLCL(CLS,11,N,0),U,2)_$C(28)

 S VALUE=$$TKO^BQIUL1(VALUE,$C(29))

 ;

 S N=0

 F  S N=$O(^APCDPLCL(CLS,12,N)) Q:'N  D

 . S HELP=HELP_^APCDPLCL(CLS,12,N,0)_$C(10)

 S HELP=$$TKO^BQIUL1(HELP,$C(10))

 S II=II+1,@DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"Y"_U_HELP_U_$G(CLEAR)_$C(30)

 Q

 ;

INIT(DATA,BQPIEN) ; EP - BQI VFILE INITIAL PRB

 NEW UID,II,VALUE,SOURCE,HELP,DXN,ABLE

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

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

 K @DATA

 S BQPIEN=$G(BQPIEN,"")

 S II=0

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

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

 S SOURCE="APCDCLAS",VALUE="",HELP="",ABLE="N"

 I BQPIEN'="",$$VERSION^XPDUTL("BJPC")'<2.0 D

 . S DXN=$$GET1^DIQ(9000011,BQPIEN,.01,"I")

 . I DXN'="",$$ASKCL^AUPNVPLC(DXN) S ABLE="Y"

 S II=II+1,@DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_ABLE_U_HELP_$C(30)

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

 Q

 ;

HDR ; Header for BQI VFILE TRIGGER PRB

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

 Q

BQIPTFHT  ;VNGT/HS/BEE-Trigger Family History Information ; 01 May 2009  3:21 PM

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

 +2        QUIT 

 +3       ;

EN(DATA,TEXT,DXN) ;EP - BQI VFILE TRIGGER PRB

 +1       ;

 +2       ; Input

 +3       ;   TEXT  - Narrative Text

 +4       ;

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

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

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

 +8        KILL @DATA

 +9        SET II=0

 +10      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +11       SET TEXT=$GET(TEXT,"")

           SET DXN=$GET(DXN,"")

 +12       DO HDR

 +13       IF DXN'=""

               DO CLS

 +14       IF TEXT'=""

               DO NAR

 +15      ;

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       ;

NAR       ;EP - Narrative Text

 +1        NEW SOURCE,VALUE,DIC,DLAYGO,X,Y,IEN

 +2        SET SOURCE="APCDN"

           SET VALUE=""

 +3        SET DIC(0)="LX"

           SET DIC="^AUTNPOV("

           SET DLAYGO=9999999.27

           SET X=TEXT

 +4        DO ^DIC

 +5        SET IEN=+Y

 +6        IF IEN=-1

               KILL DO,DD

               DO FILE^DICN

               SET IEN=+Y

 +7        SET VALUE=IEN_$CHAR(29)_TEXT

 +8        SET II=II+1

           SET @DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_U_U_$CHAR(30)

 +9        QUIT 

 +10      ;

CLS       ;EP - Problem Classification

 +1        NEW SOURCE,VALUE,HELP,CLS,NUM,N

 +2        SET SOURCE="APCDCLAS"

           SET VALUE=""

           SET HELP=""

 +3        IF $$VERSION^XPDUTL("BJPC")<2.0

               Begin DoDot:1

 +4                SET II=II+1

                   SET @DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"N"_U_HELP_U_$GET(CLEAR)_$CHAR(30)

               End DoDot:1

               QUIT 

 +5       ; If diagnosis does not trigger a classification

 +6        IF '$$ASKCL^AUPNVPLC(DXN)

               Begin DoDot:1

 +7                SET CLEAR=SOURCE

 +8                SET II=II+1

                   SET @DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"N"_U_HELP_U_$GET(CLEAR)_$CHAR(30)

               End DoDot:1

               QUIT 

 +9       ;

 +10       SET CLS=$ORDER(^APCDPLCL("B","ASTHMA SEVERITY",""))

           IF CLS=""

               Begin DoDot:1

 +11               SET II=II+1

                   SET @DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"N"_U_HELP_U_$GET(CLEAR)_$CHAR(30)

               End DoDot:1

               QUIT 

 +12      ;

 +13       SET N=0

 +14       FOR 

               SET N=$ORDER(^APCDPLCL(CLS,11,N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +15               SET NUM=$PIECE(^APCDPLCL(CLS,11,N,0),U,1)

 +16               SET VALUE=VALUE_NUM_$CHAR(29)_NUM_"-"_$PIECE(^APCDPLCL(CLS,11,N,0),U,2)_$CHAR(28)

               End DoDot:1

 +17       SET VALUE=$$TKO^BQIUL1(VALUE,$CHAR(29))

 +18      ;

 +19       SET N=0

 +20       FOR 

               SET N=$ORDER(^APCDPLCL(CLS,12,N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +21               SET HELP=HELP_^APCDPLCL(CLS,12,N,0)_$CHAR(10)

               End DoDot:1

 +22       SET HELP=$$TKO^BQIUL1(HELP,$CHAR(10))

 +23       SET II=II+1

           SET @DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_"Y"_U_HELP_U_$GET(CLEAR)_$CHAR(30)

 +24       QUIT 

 +25      ;

INIT(DATA,BQPIEN) ; EP - BQI VFILE INITIAL PRB

 +1        NEW UID,II,VALUE,SOURCE,HELP,DXN,ABLE

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

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

 +4        KILL @DATA

 +5        SET BQPIEN=$GET(BQPIEN,"")

 +6        SET II=0

 +7       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

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

 +9        SET SOURCE="APCDCLAS"

           SET VALUE=""

           SET HELP=""

           SET ABLE="N"

 +10       IF BQPIEN'=""

               IF $$VERSION^XPDUTL("BJPC")'<2.0

                   Begin DoDot:1

 +11                   SET DXN=$$GET1^DIQ(9000011,BQPIEN,.01,"I")

 +12                   IF DXN'=""

                           IF $$ASKCL^AUPNVPLC(DXN)

                               SET ABLE="Y"

                   End DoDot:1

 +13       SET II=II+1

           SET @DATA@(II)=SOURCE_U_"C"_U_VALUE_U_U_ABLE_U_HELP_$CHAR(30)

 +14       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +15       QUIT 

 +16      ;

HDR       ; Header for BQI VFILE TRIGGER PRB

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

 +2        QUIT