BQIBHSFP.m

BQIBHSFP ;VNGT/HS/BEE - Behav Health Suicide Form Print ; 19 Jul 2006  10:35 AM

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

 ;

 Q

 ;

EN(DATA,BQIHSF) ; EP - BQI BH PRINT SUICIDE FORM

 ;Description

 ;  Print a selected suicide form for a patient

 ;

 ;Input

 ;  BQIHSF - Internal IEN of the suicide form

 ;

 ;Output

 ;  DATA - Name of global in which data is stored(^TMP("BQIBHSFP"))

 ;

 NEW UID,II,APCDSF,APCDX,AM

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

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

 K @DATA

 ;

 S II=0

 ;

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

 ;

 D HDR

 ;

 S APCDSF=BQIHSF

 ;

 ;Compile Form

 K ^TMP("APCDS",$J)

 D EP2^APCDLES1(APCDSF)

 ;

 S II=II+1,@DATA@(II)="********** CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"]  "_$$FMTE^XLFDT(DT)_" **********"_$C(13)_$C(10)

 ;

 S APCDX=0 F  S APCDX=$O(^TMP("APCDS",$J,"DCS",APCDX)) Q:APCDX'=+APCDX  D

 .S AM=$G(^TMP("APCDS",$J,"DCS",APCDX))

 .S AM=$$STRIP^XLFSTR(AM,"^")

 .S II=II+1,@DATA@(II)=AM_$C(13)_$C(10)

 S @DATA@(II)=$G(@DATA@(II))_$C(30)

 ;

DONE ;

 ;

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

 Q

 ;

HDR ;

 S @DATA@(II)="T01024REPORT_TEXT"_$C(30)

 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

BQIBHSFP  ;VNGT/HS/BEE - Behav Health Suicide Form Print ; 19 Jul 2006  10:35 AM

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

 +2       ;

 +3        QUIT 

 +4       ;

EN(DATA,BQIHSF) ; EP - BQI BH PRINT SUICIDE FORM

 +1       ;Description

 +2       ;  Print a selected suicide form for a patient

 +3       ;

 +4       ;Input

 +5       ;  BQIHSF - Internal IEN of the suicide form

 +6       ;

 +7       ;Output

 +8       ;  DATA - Name of global in which data is stored(^TMP("BQIBHSFP"))

 +9       ;

 +10       NEW UID,II,APCDSF,APCDX,AM

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

 +12       SET DATA=$NAME(^TMP("BQIBHSFP",UID))

 +13       KILL @DATA

 +14      ;

 +15       SET II=0

 +16      ;

 +17      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +18      ;

 +19       DO HDR

 +20      ;

 +21       SET APCDSF=BQIHSF

 +22      ;

 +23      ;Compile Form

 +24       KILL ^TMP("APCDS",$JOB)

 +25       DO EP2^APCDLES1(APCDSF)

 +26      ;

 +27       SET II=II+1

           SET @DATA@(II)="********** CONFIDENTIAL PATIENT INFORMATION ["_$PIECE(^VA(200,DUZ,0),U,2)_"]  "_$$FMTE^XLFDT(DT)_" **********"_$CHAR(13)_$CHAR(10)

 +28      ;

 +29       SET APCDX=0

           FOR 

               SET APCDX=$ORDER(^TMP("APCDS",$JOB,"DCS",APCDX))

               IF APCDX'=+APCDX

                   QUIT 

               Begin DoDot:1

 +30               SET AM=$GET(^TMP("APCDS",$JOB,"DCS",APCDX))

 +31               SET AM=$$STRIP^XLFSTR(AM,"^")

 +32               SET II=II+1

                   SET @DATA@(II)=AM_$CHAR(13)_$CHAR(10)

               End DoDot:1

 +33       SET @DATA@(II)=$GET(@DATA@(II))_$CHAR(30)

 +34      ;

DONE      ;

 +1       ;

 +2        SET II=II+1

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

 +3        QUIT 

 +4       ;

HDR       ;

 +1        SET @DATA@(II)="T01024REPORT_TEXT"_$CHAR(30)

 +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