BQIBHSFL.m

BQIBHSFL ;VNGT/HS/ALA-Behav Health Suicide Form List ; 01 Mar 2011  3:37 PM

 ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37

 ;

 ;

EN(DATA,DFN) ;EP -- BQI BH GET SUICIDE FORMS

 ; Input Parameter

 ;   DFN - Patient internal entry number

 ; 

 NEW UID,II,HDR,IEN,SDATA,DTACT,BEH,METH,MT,UCR,DCR,ULM,DLM

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

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

 K @DATA

 S II=0

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

 S HDR="I00010HIDE_IEN^D00015DATE_ACT^T00030BEHAVIOR^T01024METHOD^T00035USER_CRT"

 S HDR=HDR_"^D00030DT_CRT^T00035USER_LSTMOD^D00030DT_LSTMOD"

 ;

 S @DATA@(II)=HDR_$C(30)

 S IEN=""

 F  S IEN=$O(^AMHPSUIC("AC",DFN,IEN)) Q:IEN=""  D

 . S SDATA=$G(^AMHPSUIC(IEN,0))

 . ; Date of Act

 . S DTACT=$P(SDATA,U,6) I DTACT="" Q

 . ; Suicide behavior

 . S BEH=$$GET1^DIQ(9002011.65,IEN_",",.13,"E") I BEH="" Q

 . ; User/Date created/last modified

 . S UCR=$$GET1^DIQ(9002011.65,IEN_",",.19,"E")

 . S DCR=$$GET1^DIQ(9002011.65,IEN_",",.18,"I")

 . S ULM=$$GET1^DIQ(9002011.65,IEN_",",.22,"E")

 . S DLM=$$GET1^DIQ(9002011.65,IEN_",",.21,"I")

 . S METH="",MT=0

 . F  S MT=$O(^AMHPSUIC(IEN,11,MT)) Q:'MT  D

 .. NEW DA,IENS

 .. S DA(1)=IEN,DA=MT,IENS=$$IENS^DILF(.DA)

 .. S METH=METH_$$GET1^DIQ(9002011.6511,IENS,.01,"E")_"; "

 . S METH=$$TKO^BQIUL1(METH,"; ")

 . S II=II+1,@DATA@(II)=IEN_U_$$FMTE^BQIUL1(DTACT)_U_BEH_U_METH_U_UCR_U_$$FMTE^BQIUL1(DCR)_U_ULM_U_$$FMTE^BQIUL1(DLM)_$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

BQIBHSFL  ;VNGT/HS/ALA-Behav Health Suicide Form List ; 01 Mar 2011  3:37 PM

 +1       ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37

 +2       ;

 +3       ;

EN(DATA,DFN) ;EP -- BQI BH GET SUICIDE FORMS

 +1       ; Input Parameter

 +2       ;   DFN - Patient internal entry number

 +3       ; 

 +4        NEW UID,II,HDR,IEN,SDATA,DTACT,BEH,METH,MT,UCR,DCR,ULM,DLM

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

 +6        SET DATA=$NAME(^TMP("BQIBHSFL",UID))

 +7        KILL @DATA

 +8        SET II=0

 +9       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +10       SET HDR="I00010HIDE_IEN^D00015DATE_ACT^T00030BEHAVIOR^T01024METHOD^T00035USER_CRT"

 +11       SET HDR=HDR_"^D00030DT_CRT^T00035USER_LSTMOD^D00030DT_LSTMOD"

 +12      ;

 +13       SET @DATA@(II)=HDR_$CHAR(30)

 +14       SET IEN=""

 +15       FOR 

               SET IEN=$ORDER(^AMHPSUIC("AC",DFN,IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +16               SET SDATA=$GET(^AMHPSUIC(IEN,0))

 +17      ; Date of Act

 +18               SET DTACT=$PIECE(SDATA,U,6)

                   IF DTACT=""

                       QUIT 

 +19      ; Suicide behavior

 +20               SET BEH=$$GET1^DIQ(9002011.65,IEN_",",.13,"E")

                   IF BEH=""

                       QUIT 

 +21      ; User/Date created/last modified

 +22               SET UCR=$$GET1^DIQ(9002011.65,IEN_",",.19,"E")

 +23               SET DCR=$$GET1^DIQ(9002011.65,IEN_",",.18,"I")

 +24               SET ULM=$$GET1^DIQ(9002011.65,IEN_",",.22,"E")

 +25               SET DLM=$$GET1^DIQ(9002011.65,IEN_",",.21,"I")

 +26               SET METH=""

                   SET MT=0

 +27               FOR 

                       SET MT=$ORDER(^AMHPSUIC(IEN,11,MT))

                       IF 'MT

                           QUIT 

                       Begin DoDot:2

 +28                       NEW DA,IENS

 +29                       SET DA(1)=IEN

                           SET DA=MT

                           SET IENS=$$IENS^DILF(.DA)

 +30                       SET METH=METH_$$GET1^DIQ(9002011.6511,IENS,.01,"E")_"; "

                       End DoDot:2

 +31               SET METH=$$TKO^BQIUL1(METH,"; ")

 +32               SET II=II+1

                   SET @DATA@(II)=IEN_U_$$FMTE^BQIUL1(DTACT)_U_BEH_U_METH_U_UCR_U_$$FMTE^BQIUL1(DCR)_U_ULM_U_$$FMTE^BQIUL1(DLM)_$CHAR(30)

               End DoDot:1

 +33      ;

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